Indsæt række efter postnr.

Er det kun 4. ciff postnr?
-
Men ellers - hvis du havde organiseret dine adresser i kolonner somen liste:
Navn1...Navn2...Adresse...Postnr...By

så kunne du anvender brevflet i Word!

Men ellers kan der skrives en makro, der identificere celler, der begynder med 4 tal-tegn og så indsætte en række. MEN er en række nok, når der kan være flere navnelinier?

Ja, det er kun 4 cifre i postnr.

Ja, det havde været nemmere i kolonner. Men da listen kommer fra et andet program, hvor de er på række er det svært at lave om.

Ja, en række er nok. Det er bare for at skelne personerne fra hinanden.

OK - vender tilbage

Indsæt denne kode i ark1 i VBA-vinduet(Alt+F11) og aktiver den med F5:

Dim antaRæk, nyLinie As Boolean
Sub AdskilAdresser()
    nyLinie = False
   
    With ActiveWorkbook.Sheets(1)
        antalræk = ActiveCell.SpecialCells(xlLastCell).Row
   
        For række = 1 To antalræk
            If nyLinie = True Then
                Rows(CStr(række) + ":" + CStr(række)).Select
                Selection.Insert Shift:=xlDown
               
                antalræk = antalræk + 1
                nyLinie = False
            Else
                indhold = Left(Cells(række, 1), 4)
               
                If IsNumeric(indhold) = True Then
                  nyLinie = True
                End If
            End If
        Next række
    End With
End Sub

Det virker.

Men!
Arket indeholder 286 rækker inden vba køres.
Når vba køres stopper den ved række 286, men der mangler stadigvæk xx rækker at blive checket.

OK - Jeg prøver at se på det igen - jeg mente at have taget højde for netop dette - med der er håb. :-)

Justeret kode: (er afprøvet med 270 rækker)

Dim antaRæk, nyLinie As Boolean
Sub AdskilAdresser()
    nyLinie = False
   
    With ActiveWorkbook.Sheets(1)
        antalræk = ActiveCell.SpecialCells(xlLastCell).Row
   
        For række = 1 To antalræk * 2
            If nyLinie = True Then
                Rows(CStr(række) + ":" + CStr(række)).Select
                Selection.Insert Shift:=xlDown
               
                nyLinie = False
            Else
                indhold = Left(Cells(række, 1), 4)
               
                If IsNumeric(indhold) = True Then
                  nyLinie = True
                End If
            End If
        Next række
    End With
End Sub

Selvfølgelig :-)


Jeg tænker lidt på det med kolonner.
Hvis nu arket fast indeholder.
A1=Navn1, B1=Navn2, C1=Adresse, D1=Postnr./By

Og man gør som følgende:
1. Indtrækker txt-filen startende i A5. (arket indeholder nu xx rækker fra A5 og ned.)
2. Kør kode. (der indsættes en række efter hver linie med Postnr./By information.)
3. Gå tilbage til A5.
4. Kør kode, som gør:
Find første tomme række. (A?)
Flyt indhold i A?-1 til D2, flyt indhold i A?-2 til C2, flyt indhold i A?-3 til B2, flyt indhold i A?-4 til A2.
Find næste tomme række. (A?)
Flyt indhold i A?-1 til D3, flyt indhold i A?-2 til C3, flyt indhold i A?-3 til B3, flyt indhold i A?-4 til A3.
OSV.
indtil alle informationer er flyttet.

Nu har vi i kolonnne form, og kan flette med Word. Korrekt?

Det hele kan udføres via en makro - således at kolonneopstillingen indsættes i ark2 på basis af opdelingen på ark1.
Så vil brevfletningen kunne udføres.

Har prøvet mig frem og kommet til følgende, men den vil ikke kopiere værdien ind i første tomme celle i kolonne D.
Jeg får en error 400.

Sub Flyt()
Range("A5").Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveCell.Offset(-1, 0).Select
Selection.Copy
Range("D1").Select
Selecyti.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
End Sub

Men hvordan vil du gøre det :-)

Selecyti.End(xlDown).Offset(1, 0).Select
er rettet til Selection.End(xlDown).Offset(1, 0).Select

Skal nok vende tilbage herom....

Dim antaRæk, nyLinie As Boolean
Dim linier(4)

Sub AdskilAdresser()                                'indsætter blank linie
    nyLinie = False
   
    With ActiveWorkbook.Sheets(1)
        antalræk = ActiveCell.SpecialCells(xlLastCell).Row
   
        For række = 1 To antalræk * 2
            If nyLinie = True Then
                Rows(CStr(række) + ":" + CStr(række)).Select
                Selection.Insert Shift:=xlDown
               
                nyLinie = False
            Else
                indhold = Left(Cells(række, 1), 4)
               
                If IsNumeric(indhold) = True Then
                  nyLinie = True
                End If
            End If
        Next række
    End With
End Sub

Sub OpbygKolonner()                                'opbygger kolonner
Dim aF, KRække
    aF = 0
    KRække = 2
   
    clearLinier
   
    With ActiveWorkbook.Sheets(1)
        antalræk = ActiveCell.SpecialCells(xlLastCell).Row
   
        For række = 1 To antalræk
                indhold = Cells(række, 1)
                If indhold <> "" Then
                    linier(aF) = indhold
                    aF = aF + 1
                Else
                    If aF > 0 Then
                        Cells(KRække, 4) = linier(0)
                        If aF = 4 Then
                            Cells(KRække, 5) = linier(1)
                            Cells(KRække, 6) = linier(2)
                              Cells(KRække, 7) = linier(3)
                        Else
                            Cells(KRække, 6) = linier(1)
                            Cells(KRække, 7) = linier(2)
                        End If
                        KRække = KRække + 1
                        aF = 0
                        clearLinier
                    End If
                End If
        Next række
    End With
End Sub
Private Sub clearLinier()
    For f = 0 To 3
        linier(f) = ""
    Next f
End Sub

Tak.
Men der er lige et par ting :-(

Den kopiere til kolonnerne D-G.
Hvis der kun er 3 linier med oplysninger er det kolonne E som er blank og ikke D.
Og alt bliver stående i kolonne A.

Hvad betyder:
Dim antaRæk, nyLinie As Boolean
Dim linier(4)
Dim aF, KRække

Er noteret - vender tilbage

Hvis kolonnerne er indrettet således:
D: Navn1
E: Navn2
F: Adresse
G: PostNr By

Ved 3 linier - antages at der kun er Navn1, derfor er kolonne E tom. Herefter kan der jo tilføjes - hvis der senere kommer et navn2

Når kørslen er overstået - sletter du blot kolonner A - C - så er data på den plads, som du ønsker. Herefter kan du evt. gemme filen under et andet navn.

Dim-sætningerne er definitionaf variabler, der anvedes i VBA-koden.

Ved 3 linier skal det antages, at der er Navn2.
Det er Navn1 som evt. bruges til ekstra oplysninger.

At slette A-C kan jo sagtens flettes ind i koden :-)

Dim antaRæk
Kan ikke rigtig se antaRæk nogen steder i koden, derfor mit spørgsmål.

Jeg har stadigvæk ikke fået løst problem problemet med hensyn til Navn2, når der kun er 3 linier. :-)

Skal et forstås sådan at D skal være blank. I så flad prøv at udskifte en del af koden i Sub OpbygKolonner(). udskift koden mellem If aF > 0 Then ... End If med flg.
Er ikke testet, så gem lige inden

If aF = 4 Then
        Cells(KRække, 4) = linier(0)
        Cells(KRække, 5) = linier(1)
        Cells(KRække, 6) = linier(2)
        Cells(KRække, 7) = linier(3)
    Else
        Cells(KRække, 5) = linier(0)
        Cells(KRække, 6) = linier(1)
        Cells(KRække, 7) = linier(2)
    End If
    KRække = KRække + 1
    aF = 0
    clearLinier

Tak mrjh, så var den der.

Lukker spm.