09. november 2006 - 13:34Der er
7 kommentarer og 1 løsning
Vb kode ombygning.
Denne her kode ser i kolonne "A:A" efter to værdier "A" Og "P" stort eller småt.
"P" Vil altid være i "A1". Der efter kan det være blandet tomme celler, tal og text
Det den skal er kun hvis en af de to værdier er i "A:A" Fra "a1" Skal den finde næste af de to værdier hvis der ikke er 4 celler i mellem dem skal dem lave dem.
Eks. "A1" = P Og "A3" = 2 Og "A4" = A Skal den indsætte rækker til der er 4 celler uden de to værdier!!
Som "A1" = P Og "A3" = 2 Og "A4" = "" Og "A6" = A
Den gør det næsten nu men ikke med .Offset(-3, 0) der dør den og den tager ikke kun A, F.
Så det må være noget med If Not = "A" Or "F" Then Sub Mellemrum() 'Kode Af Bak!! rw = Range("A65536").End(xlUp).row For i = rw To 3 Step -1 If ucase(Cells(i, 1)) = "A" or ucase(Cells(i, 1)) = "P" Then If Cells(i, 1).Offset(-1, 0) = "" And Cells(i, 1).Offset(-2, 0) = "" And Cells(i, 1).Offset(-3, 0) = "" Then Else Rows(i & ":" & i).Insert Shift:=xlDown End If End If
prøv : Sub tst() Dim x As Range Cells(1, 1).Activate Set x = ActiveCell While x <> "" While UCase(x.Offset(1, 0)) = "A" Or UCase(x.Offset(1, 0)) = "P" Or UCase(x.Offset(2, 0)) = "A" Or _ UCase(x.Offset(2, 0)) = "P" Or UCase(x.Offset(3, 0)) = "A" Or UCase(x.Offset(3, 0)) = "P" Or _ UCase(x.Offset(4, 0)) = "A" Or UCase(x.Offset(4, 0)) = "P" x.Offset(1, 0).Rows.Insert Wend x.Offset(5, 0).Activate Set x = ActiveCell Wend End Sub
excelent der er en fejl. den skal ud fra "A:A" Hvis A & P er der lave nye rækker. så hvis "A1" = p og "A4" = a. Skal den lave nye rækker til der er 4 celler i mellem p a ovs som hvis man selv mærker række "A4" og trykker ctrl+
Sub tst() Dim x As Range Cells(1, 1).Activate Set x = ActiveCell While x <> "" While UCase(x.Offset(1, 0)) = "A" Or UCase(x.Offset(1, 0)) = "P" Or UCase(x.Offset(2, 0)) = "A" Or _ UCase(x.Offset(2, 0)) = "P" Or UCase(x.Offset(3, 0)) = "A" Or UCase(x.Offset(3, 0)) = "P" Or _ UCase(x.Offset(4, 0)) = "A" Or UCase(x.Offset(4, 0)) = "P" rw = Range("A65536").End(xlUp).row For i = rw To 4 Step -1 If UCase(Cells(i, 1)) = "A" Or UCase(Cells(i, 1)) = "P" Then Rows(i & ":" & i).Insert Shift:=xlDown End If Next Wend x.Offset(5, 0).Activate Set x = ActiveCell Wend End Sub
Den date i de andre kolonner skal også flyttes med
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
