Vb opslag i opslag

Har den..

Koden...

Vil du se den!?

Det vil andre, og ifl. reglerne skal man give svar på egne løsninger. Du kan angive hele koden, eller blot lave et eksempel på hvad du har gjort.

Arr ok på den måde..
Men min kode virker på den her måde!

Den henter kunder som skal køre på en bestemt dag via en userform vælger man dagen i en 14 dags periode lige ulig uge og ud fra en Institution.

så laver den en liste over hvem der skal med den dag og på hvilken tur.
Den kan sikkert nok laves på en anden måde men det er måden den virker for mig. ps :S

Sub Add()
Dim i, o, p, n As Integer
Dim Rng As Range
Dim Map As String
Dim Arr(2 To 1182, 45) As Variant
Dim d, nx As Variant
Hj = 1 And 2 And 3 And 4 And 5
Inst = Ins
A1 = "Kunder"
A2 = "Ark"
A3 = "Institution"
d = Sheets(A1).Cells(1, 18).Value

Application.ScreenUpdating = False
'Mandag Lige Ude                                            'Mandag Ulige Ude
'0 = Tur1. 4 = Tur2. 8 = Tur3. 12 = Tur4. 16 = Tur5.        '100 = Tur1. 104 = Tur2. 108 = Tur3. 112 = Tur4. 116 = Tur5.
'Tirsdag Lige Ude                                          'Tirsdag Ulige Ude
'20 = Tur1. 24 = Tur2. 28 = Tur3. 32 = Tur4. 36 = Tur5.    '120 = Tur1. 124 = Tur2. 128 = Tur3. 132 = Tur4. 136 = Tur5.
'Onsdag Lige Ude                                            'Onsdag Ulige Ude
'40 = Tur1. 44 = Tur2. 48 = Tur3. 52 = Tur4. 56 = Tur5.    '140 = Tur1. 144 = Tur2. 148 = Tur3. 152 = Tur4. 156 = Tur5.
'Torsdag Lige Ude                                          'Torsdag Ulige Ude
'60 = Tur1. 64 = Tur2. 68 = Tur3. 72 = Tur4. 76 = Tur5.    '160 = Tur1. 164 = Tur2. 168 = Tur3. 172 = Tur4. 176 = Tur5.
'Fredag Lige Ude                                            'Fredag Ulige Ude
'80 = Tur1. 84 = Tur2. 88 = Tur3. 92 = Tur4. 96 = Tur5.    '180 = Tur1. 184 = Tur2. 188 = Tur3. 192 = Tur4. 196 = Tur5.
'Application.ScreenUpdating = False
For i = 2 To 1182
    Arr(i, 0) = Sheets(A2).Cells(i, 1).Value 'DepotIDPerson
    Arr(i, 1) = Sheets(A2).Cells(i, 2).Value 'FornavnPerson
    Arr(i, 2) = Sheets(A2).Cells(i, 3).Value 'MellemnavnPerson
    Arr(i, 3) = Sheets(A2).Cells(i, 4).Value 'EfternavnPerson
    Arr(i, 4) = Sheets(A2).Cells(i, 16).Value 'CprPerson
    Arr(i, 5) = Sheets(A2).Cells(i, 17).Value 'DatoPerson
    Arr(i, 6) = Sheets(A2).Cells(i, 14).Value 'Adresse_Id 1
    Arr(i, 7) = Sheets(A2).Cells(i, 5).Value 'Gade 1
    Arr(i, 8) = Sheets(A2).Cells(i, 6).Value 'Nr 1
    Arr(i, 9) = Sheets(A2).Cells(i, 7).Value 'Bogstav 1
    Arr(i, 10) = Sheets(A2).Cells(i, 8).Value 'Etagse 1
    Arr(i, 11) = Sheets(A2).Cells(i, 9).Value 'Side 1
    Arr(i, 12) = Sheets(A2).Cells(i, 10).Value 'Post 1
    Arr(i, 13) = Sheets(A2).Cells(i, 12).Value 'Telefon 1
    Arr(i, 14) = Sheets(A2).Cells(i, 13).Value 'Ekstratid 1
    Arr(i, 15) = Sheets(A2).Cells(i, 15).Value 'Info 1
    Arr(i, 16) = Sheets(A2).Cells(i, 27).Value 'Adresse_Id 2
    Arr(i, 17) = Sheets(A2).Cells(i, 18).Value 'Gade 2
    Arr(i, 18) = Sheets(A2).Cells(i, 19).Value 'Nr 2
    Arr(i, 19) = Sheets(A2).Cells(i, 20).Value 'Bogstav 2
    Arr(i, 20) = Sheets(A2).Cells(i, 21).Value 'Etagse 2
    Arr(i, 21) = Sheets(A2).Cells(i, 22).Value 'Side 2
    Arr(i, 22) = Sheets(A2).Cells(i, 23).Value 'Post 2
    Arr(i, 23) = Sheets(A2).Cells(i, 25).Value 'Telefon 2
    Arr(i, 24) = Sheets(A2).Cells(i, 26).Value 'Ekstratid 2
    Arr(i, 25) = Sheets(A2).Cells(i, 28).Value 'Info 2
    Arr(i, 26) = Sheets(A2).Cells(i, 29 + d).Value 'Fra Tur
    Arr(i, 27) = Sheets(A2).Cells(i, 30 + d).Value 'Fra Tid Tur
    Arr(i, 28) = Sheets(A2).Cells(i, 31 + d).Value 'Til Tur
    Arr(i, 29) = Sheets(A2).Cells(i, 32 + d).Value 'Til Tid Tur


If Sheets(A2).Cells(i, 29 + d).Value <> "" Then
  If Sheets(A2).Cells(i, 29 + d).Value >= 16 Then
      Map = Sheets(A2).Cells(i, 29 + d).Value
  Else
      If Sheets(A2).Cells(i, 31 + d).Value >= 16 Then
        Map = Sheets(A2).Cells(i, 31 + d).Value
      End If
  End If
  Set Rng = Sheets(A3).Range("A2:A59")
  For Each M In Rng
      If M.Value = Map Then
        n = M.Row
        'Exit For
      End If
  Set Rng = Sheets(A3).Range("A2:A59")
  If n <> 0 Then
      Arr(i, 30) = Sheets(A3).Cells(n, 1).Value 'IdIinstitution
      Arr(i, 31) = Sheets(A3).Cells(n, 2).Value 'InstitutionNavnIinstitution
      Arr(i, 32) = Sheets(A3).Cells(n, 3).Value 'MellemnavnIinstitution
      Arr(i, 33) = Sheets(A3).Cells(n, 4).Value 'EfternavnIinstitution
      Arr(i, 34) = Sheets(A3).Cells(n, 5).Value 'GadeIinstitution
      Arr(i, 35) = Sheets(A3).Cells(n, 6).Value 'NrIinstitution
      Arr(i, 36) = Sheets(A3).Cells(n, 7).Value 'BogstavIinstitution
      Arr(i, 37) = Sheets(A3).Cells(n, 8).Value 'EtagseIinstitution
      Arr(i, 38) = Sheets(A3).Cells(n, 9).Value 'SideIinstitution
      Arr(i, 39) = Sheets(A3).Cells(n, 10).Value 'PostnrIinstitution
      Arr(i, 40) = Sheets(A3).Cells(n, 12).Value 'TelefonIinstitution
      Arr(i, 41) = Sheets(A3).Cells(n, 13).Value 'EkstraIinstitution
      Arr(i, 42) = Sheets(A3).Cells(n, 14).Value 'Ardesse_IdIinstitution
      Arr(i, 43) = Sheets(A3).Cells(n, 15).Value 'InfoIinstitution
      Arr(i, 44) = Sheets(A3).Cells(n, 16).Value 'IInstitution
      Arr(i, 45) = Sheets(A3).Cells(n, 19).Value 'IdIinstitution
    End If
  Next M
End If
Next i

o = 2
For p = 2 To 1182


  Fra = Arr(p, 26)
  Til = Arr(p, 28)
 

If Fra <> "" And Til <> "" Then
'If Fra = Sheets(A1).Cells(1, 17) Or Til = Sheets(A1).Cells(o, 13) Then

  If Fra = 1 Or Fra = 2 Then
Sheets(A1).Cells(o, 1) = Arr(p, 0) 'DepotID
Sheets(A1).Cells(o, 2) = Arr(p, 1) 'Fornavn
Sheets(A1).Cells(o, 3) = Arr(p, 2) 'Mellemnavn
Sheets(A1).Cells(o, 4) = Arr(p, 3) 'Efternavn
Sheets(A1).Cells(o, 15) = Arr(p, 4) 'Cpr
Sheets(A1).Cells(o, 16) = Arr(p, 5) 'Dato
Sheets(A1).Cells(o, 18) = "1"
Sheets(A1).Cells(o, 17) = Fra
Sheets(A1).Cells(o, 19) = Arr(p, 27) - "0,0104166666666667"
Sheets(A1).Cells(o, 20) = Arr(p, 27)
Sheets(A1).Cells(o, 23) = Sheets(A1).Cells(1, 23)
Sheets(A1).Cells(o, 24) = Sheets(A1).Cells(1, 24)
      Select Case Fra
     
        Case Is = 1
Sheets(A1).Cells(o, 13) = Arr(p, 6) 'Adresse_Id 1
Sheets(A1).Cells(o, 5) = Arr(p, 7) 'Gade 1
Sheets(A1).Cells(o, 6) = Arr(p, 8) 'Nr 1
Sheets(A1).Cells(o, 7) = Arr(p, 9) 'Bogstav 1
Sheets(A1).Cells(o, 8) = Arr(p, 10) 'Etagse 1
Sheets(A1).Cells(o, 9) = Arr(p, 11) 'Side 1
Sheets(A1).Cells(o, 10) = Arr(p, 12) 'Post 1
Sheets(A1).Cells(o, 11) = Arr(p, 13) 'Telefon 1
Sheets(A1).Cells(o, 12) = Arr(p, 14) 'Ekstratid 1
Sheets(A1).Cells(o, 14) = Arr(p, 15) 'Info 1
        Case Is = 2
Sheets(A1).Cells(o, 13) = Arr(p, 16) 'Adresse_Id 2
Sheets(A1).Cells(o, 5) = Arr(p, 17) 'Gade 2
Sheets(A1).Cells(o, 6) = Arr(p, 18) 'Nr 2
Sheets(A1).Cells(o, 7) = Arr(p, 19) 'Bogstav 2
Sheets(A1).Cells(o, 8) = Arr(p, 20) 'Etagse 2
Sheets(A1).Cells(o, 9) = Arr(p, 21) 'Side 2
Sheets(A1).Cells(o, 10) = Arr(p, 22) 'Post 2
Sheets(A1).Cells(o, 11) = Arr(p, 23) 'Telefon 2
Sheets(A1).Cells(o, 12) = Arr(p, 24) 'Ekstratid 2
Sheets(A1).Cells(o, 14) = Arr(p, 25) 'Info 2

        Case Else
      End Select
      Else
  End If
  If Til = 1 Or Til = 2 Then
Sheets(A1).Cells(o, 1) = Arr(p, 0) 'DepotID
Sheets(A1).Cells(o, 2) = Arr(p, 1) 'Fornavn
Sheets(A1).Cells(o, 3) = Arr(p, 2) 'Mellemnavn
Sheets(A1).Cells(o, 4) = Arr(p, 3) 'Efternavn
Sheets(A1).Cells(o, 15) = Arr(p, 4) 'Cpr
Sheets(A1).Cells(o, 16) = Arr(p, 5) 'Dato
Sheets(A1).Cells(o, 18) = "2"
Sheets(A1).Cells(o, 17) = Til
Sheets(A1).Cells(o, 19) = Arr(p, 29)
Sheets(A1).Cells(o, 20) = Arr(p, 29) + "0,0104166666666667"
Sheets(A1).Cells(o, 23) = Sheets(A1).Cells(1, 23) + 1
Sheets(A1).Cells(o, 24) = Sheets(A1).Cells(1, 24)
      Select Case Til
        Case Is = 1
Sheets(A1).Cells(o, 13) = Arr(p, 6) 'Adresse_Id 1
Sheets(A1).Cells(o, 5) = Arr(p, 7) 'Gade 1
Sheets(A1).Cells(o, 6) = Arr(p, 8) 'Nr 1
Sheets(A1).Cells(o, 7) = Arr(p, 9) 'Bogstav 1
Sheets(A1).Cells(o, 8) = Arr(p, 10) 'Etagse 1
Sheets(A1).Cells(o, 9) = Arr(p, 11) 'Side 1
Sheets(A1).Cells(o, 10) = Arr(p, 12) 'Post 1
Sheets(A1).Cells(o, 11) = Arr(p, 13) 'Telefon 1
Sheets(A1).Cells(o, 12) = Arr(p, 14) 'Ekstratid 1
Sheets(A1).Cells(o, 14) = Arr(p, 15) 'Info 1
        Case Is = 2
Sheets(A1).Cells(o, 13) = Arr(p, 16) 'Adresse_Id 2
Sheets(A1).Cells(o, 5) = Arr(p, 17) 'Gade 2
Sheets(A1).Cells(o, 6) = Arr(p, 18) 'Nr 2
Sheets(A1).Cells(o, 7) = Arr(p, 19) 'Bogstav 2
Sheets(A1).Cells(o, 8) = Arr(p, 20) 'Etagse 2
Sheets(A1).Cells(o, 9) = Arr(p, 21) 'Side 2
Sheets(A1).Cells(o, 10) = Arr(p, 22) 'Post 2
Sheets(A1).Cells(o, 11) = Arr(p, 23) 'Telefon 2
Sheets(A1).Cells(o, 12) = Arr(p, 24) 'Ekstratid 2
Sheets(A1).Cells(o, 14) = Arr(p, 25) 'Info 2
        Case Else
      End Select
    Else
  End If
  If Fra >= 11 And Fra < 91 Then
Sheets(A1).Cells(o + 1, 17) = Arr(p, 30) 'Id
Sheets(A1).Cells(o + 1, 2) = Arr(p, 31) 'InstitutionNavn
Sheets(A1).Cells(o + 1, 3) = Arr(p, 32) 'Mellemnavn
Sheets(A1).Cells(o + 1, 4) = Arr(p, 33) 'Efternavn
Sheets(A1).Cells(o + 1, 5) = Arr(p, 34) 'Gade
Sheets(A1).Cells(o + 1, 6) = Arr(p, 35) 'Nr
Sheets(A1).Cells(o + 1, 7) = Arr(p, 36) 'Bogstav
Sheets(A1).Cells(o + 1, 8) = Arr(p, 37) 'Etagse
Sheets(A1).Cells(o + 1, 9) = Arr(p, 38) 'Side
Sheets(A1).Cells(o + 1, 10) = Arr(p, 39) 'Postnr
Sheets(A1).Cells(o + 1, 11) = Arr(p, 40) 'Telefon
Sheets(A1).Cells(o + 1, 12) = Arr(p, 41) 'Ekstra
Sheets(A1).Cells(o + 1, 13) = Arr(p, 42) 'Ardesse_Id
Sheets(A1).Cells(o + 1, 14) = Arr(p, 43) 'Info
Sheets(A1).Cells(o + 1, 15) = Arr(p, 44) 'IInstitution_Id
Sheets(A1).Cells(o + 1, 16) = Arr(p, 5) 'Dato
Sheets(A1).Cells(o + 1, 18) = "1"
Sheets(A1).Cells(o + 1, 19) = Arr(p, 27)
Sheets(A1).Cells(o + 1, 20) = Arr(p, 27) + "0,0104166666666667"
Sheets(A1).Cells(o + 1, 1) = Arr(p, 45)
Sheets(A1).Cells(o + 1, 23) = Sheets(A1).Cells(1, 23)
Sheets(A1).Cells(o + 1, 24) = Sheets(A1).Cells(1, 24)
      Else
  End If
      If Til >= 11 And Til < 91 Then
Sheets(A1).Cells(o + 1, 17) = Arr(p, 30) 'Id
Sheets(A1).Cells(o + 1, 2) = Arr(p, 31) 'InstitutionNavn
Sheets(A1).Cells(o + 1, 3) = Arr(p, 32) 'Mellemnavn
Sheets(A1).Cells(o + 1, 4) = Arr(p, 33) 'Efternavn
Sheets(A1).Cells(o + 1, 5) = Arr(p, 34) 'Gade
Sheets(A1).Cells(o + 1, 6) = Arr(p, 35) 'Nr
Sheets(A1).Cells(o + 1, 7) = Arr(p, 36) 'Bogstav
Sheets(A1).Cells(o + 1, 8) = Arr(p, 37) 'Etagse
Sheets(A1).Cells(o + 1, 9) = Arr(p, 38) 'Side
Sheets(A1).Cells(o + 1, 10) = Arr(p, 39) 'Postnr
Sheets(A1).Cells(o + 1, 11) = Arr(p, 40) 'Telefon
Sheets(A1).Cells(o + 1, 12) = Arr(p, 41) 'Ekstra
Sheets(A1).Cells(o + 1, 13) = Arr(p, 42) 'Ardesse_Id
Sheets(A1).Cells(o + 1, 14) = Arr(p, 43) 'Info
Sheets(A1).Cells(o + 1, 15) = Arr(p, 44) 'IInstitution_Id
Sheets(A1).Cells(o + 1, 16) = Arr(p, 5) 'Dato
Sheets(A1).Cells(o + 1, 18) = "2"
Sheets(A1).Cells(o + 1, 19) = Arr(p, 29) - "0,00694444444444444"
Sheets(A1).Cells(o + 1, 20) = Arr(p, 29)
Sheets(A1).Cells(o + 1, 1) = Arr(p, 45)
Sheets(A1).Cells(o + 1, 23) = Sheets(A1).Cells(1, 23) + 1
Sheets(A1).Cells(o + 1, 24) = Sheets(A1).Cells(1, 24)
      Else
 
  End If
  If Til > 0 And Til < 91 And Fra > 0 And Fra < 91 Then
  If Arr(p, 1) <> "" And Arr(p, 31) <> "" Then
  If Sheets(A1).Cells(1, 17) = Til Or Sheets(A1).Cells(1, 17) = Fra Then
  o = o + 2
  Sheets(A1).Cells(1, 23) = Sheets(A1).Cells(1, 23) + 2 'Orderid
  Sheets(A1).Cells(1, 24) = Sheets(A1).Cells(1, 24) + 1 'Superid
  End If
  End If
  Else
  End If
Else
End If

  Next p


Application.ScreenUpdating = True
End Sub

Humm det er lige nogle små fejl og et spøgelse!? eller bare en kunde som hele tiden kommer med om selv om den ikke er med på arket.. :S

Fyr ham...