"Amputerede" rækker i liste

Du skal være velkommen til at sende filen/uddrag til: pb@supertekst-it.dk

Pb: Jeg takker for en rigtig god løsning!

Hvorledes med point til dig?

Rem Version 2- 08-06-08
Rem Koden indlægges i arket REDIGERET LISTE
Dim mArk
Dim rArk, rRække, dRække
Sub RedigerModtagetListe()
    Application.ScreenUpdating = False
   
    Set mArk = ActiveWorkbook.Sheets("ModtagetFil")
    Set rArk = ActiveWorkbook.Sheets("RedigeretFil")
    rRække = 6
    dRække = 0
   
    hentDataFraModtaget
   
    rArk.Activate
    rArk.Columns.AutoFit
   
    Application.ScreenUpdating = True
   
    MsgBox ("Redigering af modtagetFil er udført")
End Sub
Private Sub hentDataFraModtaget()
Dim modtagelsesDato
    rArk.Range("H1") = mArk.Range("E1")
   
Rem Behandling af medarb.data
    mArk.Activate
    sidsterække = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem Find celler i kolonne A med udfyldt celle - begynd efter indholdet "Medarbejder"
    For ræk = 1 To sidsterække
        celle = mArk.Cells(ræk, 1)
        If LCase(celle) = "medarbejder" Then
            dRække = ræk
        End If
       
        If celle <> "" And ræk > dRække And dRække > 0 Then
            undersøgMedarbData ræk
            rRække = rRække + 1
        End If
    Next ræk
   
End Sub
Private Sub undersøgMedarbData(ræk)
    rArk.Cells(rRække, 1) = mArk.Cells(ræk, 1)          'MedarbejderNr/Initialer
    rArk.Cells(rRække, 1).NumberFormat = "0.00"
    rArk.Cells(rRække, 1).HorizontalAlignment = xlCenter

    rArk.Cells(rRække, 2) = mArk.Cells(ræk, 2)          'Navn
    rArk.Cells(rRække, 3) = mArk.Cells(ræk, 3)          'Afdeling
    rArk.Cells(rRække, 4) = mArk.Cells(ræk, 4)          'Adresse 1
    rArk.Cells(rRække, 7) = mArk.Cells(ræk, 5)          'TelefonNr
   
Rem Test om 4 første tegn i kolonne D - næste række er numerisk - så Postnr - ellers Adresse 2
    If IsNumeric(Left(mArk.Cells(ræk + 1, 4), 4)) = True Then
        rArk.Cells(rRække, 6) = mArk.Cells(ræk + 1, 4)  'Postnr By
        rArk.Cells(rRække, 8) = mArk.Cells(ræk + 1, 5)  'Email
    Else
        rArk.Cells(rRække, 5) = mArk.Cells(ræk + 1, 4)  'Adresse 2
        rArk.Cells(rRække, 6) = mArk.Cells(ræk + 2, 4)  'Postnr By
        rArk.Cells(rRække, 8) = mArk.Cells(ræk + 2, 5)  'Email
    End If
End Sub

pb: Jeg takker mange gange for din løsning!

Hvis jeg skal have point - så skal du finde mit svar og acceptere dette.
PS: Send din egne bemærkninger som "kommentar" og ikke som "svar"... :-)

Håber det lykkes denne gang.

Det gjorde det ikke....
Du skal finde mit svar (8/6 18:21) og derefter punktet "Accepter svar".

Lidt supplerende info:
Prøv og læs http://www.expfaq.dk/?id=3#behandling_af_svar

Ja - det var jo en billig omgang...

Undskyld pb - jeg er ikke helt med...

Hvad mener du med at det var en billig omgang?

Det er selvfølgelig min inderste mening, at du skal have dine 150 point - har jeg da gjort noget galt - igen.

Så lad mig da høre...

Næ - det er forståeligt.
Når du stiller et spørgsmål og nogle kommer med forslag til løsning - så kan disse blive meddelt dig som en kommentar eller et svar.

Opgavestilleren kan så reflektere på disse med:
kommentar / afvist svar / eller accepteret svar - (og altså ikke Svar).

Det du kom til, var at afvise mit svar og selv tage points.
Det var det jeg mente :-)

Det har slet og ret aldrig været min intention!!!

Hvorledes kan der rettes op på dette?

Som du kan læse af mine kommentarer, har jeg været virkelig lykkelig for din løsning.

Nej, det ved jeg - alt tilgivet.

Du opretter et nyt spørgsmål med samme antal point under Excel med titlen: "Point til Supertekst" og i selve teksten henviser du blot til dit tidligere spørgsmål - med angivelse af spørgsmålets nummer: 834002.
Så ved alle, hvad det betyder. Det er sket før i historien....
Jeg lægger så et svar, som du så blot acceptere...