Avatar billede splokit Nybegynder
03. november 2006 - 15:05 Der er 6 kommentarer og
1 løsning

Vb Opslag

Hey hvordan får jeg arr(p, 6 to 20) til at være som en
eks for x = 6 to 20
Arr(i, x)
next x
og kun hvis der er en værdi er en værdi i cellen skal del lave den grøn!!

Private Sub DriverName_Combo_Change()
Dim i, o, p As Integer
Dim Arr(3 To 150, 20) As Variant
Mappe = "Ark1"
ArkNavn = "Dage.xls"
Farve = "4" ' Grøn
Application.ScreenUpdating = False

On Error Resume Next
Workbooks("cha.xls").Activate
If Err.Number <> 0 Then Workbooks.Open "G:\cha.xls"

For i = 3 To 150
    Arr(i, 0) = Sheets("Chau").Cells(i, 1).Value 'Navn
    Arr(i, 1) = Sheets("Chau").Cells(i, 2).Value 'Irl Navn
    Arr(i, 2) = Sheets("Chau").Cells(i, 36).Value 'LønNr
    Arr(i, 3) = Sheets("Chau").Cells(i, 38).Value 'Acc tillæg
    Arr(i, 4) = Sheets("Chau").Cells(i, 41).Value 'Time Løn
    Arr(i, 5) = Sheets("Chau").Cells(i, 43).Value 'Løn Kode
    'Celler "T:AG"
    Arr(i, 6) = Sheets("Chau").Cells(i, 20).Value
    Arr(i, 7) = Sheets("Chau").Cells(i, 21).Value
    Arr(i, 8) = Sheets("Chau").Cells(i, 22).Value
    Arr(i, 9) = Sheets("Chau").Cells(i, 23).Value
    Arr(i, 10) = Sheets("Chau").Cells(i, 24).Value
    Arr(i, 11) = Sheets("Chau").Cells(i, 25).Value
    Arr(i, 12) = Sheets("Chau").Cells(i, 26).Value
    Arr(i, 13) = Sheets("Chau").Cells(i, 27).Value
    Arr(i, 14) = Sheets("Chau").Cells(i, 28).Value
    Arr(i, 15) = Sheets("Chau").Cells(i, 29).Value
    Arr(i, 16) = Sheets("Chau").Cells(i, 30).Value
    Arr(i, 17) = Sheets("Chau").Cells(i, 31).Value
    Arr(i, 18) = Sheets("Chau").Cells(i, 32).Value
    Arr(i, 19) = Sheets("Chau").Cells(i, 33).Value

Next i
   
ActiveWorkbook.Close
Workbooks(ArkNavn).Activate
Windows(Mappe).Activate
For p = 3 To 150
If DriverName_Combo.Value = Arr(p, 0) Then
            Sheets(Mappe).Cells(2, 13) = Arr(p, 1)
            Sheets(Mappe).Cells(3, 14) = Arr(p, 2)
            LoenNrBox.Value = Arr(p, 2)
            Sheets(Mappe).Cells(1, 25) = Arr(p, 3)
            Sheets(Mappe).Cells(12, 20) = Arr(p, 4)
            Sheets(Mappe).Cells(12, 22) = Arr(p, 5)
           
           
            If Arr(p, 6).Value = True Then
            Sheets(Mappe).Cells(4, 4).Interior.ColorIndex = Farve
            Else
            Sheets(Mappe).Cells(4, 4).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 7).Value = True Then
            Sheets(Mappe).Cells(4, 5).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 5).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 8).Value = True Then
            Sheets(Mappe).Cells(4, 6).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 6).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 9).Value = True Then
            Sheets(Mappe).Cells(4, 7).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 7).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 10).Value = True Then
            Sheets(Mappe).Cells(4, 8).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 8).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 11).Value = True Then
            Sheets(Mappe).Cells(4, 9).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 9).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 12).Value = True Then
            Sheets(Mappe).Cells(4, 10).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 10).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 13).Value = True Then
            Sheets(Mappe).Cells(4, 11).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 11).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 14).Value = True Then
            Sheets(Mappe).Cells(4, 12).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 12).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 15).Value = True Then
            Sheets(Mappe).Cells(4, 13).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 13).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 16).Value = True Then
            Sheets(Mappe).Cells(4, 14).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 14).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 17).Value = True Then
            Sheets(Mappe).Cells(4, 15).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 15).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 18).Value = True Then
            Sheets(Mappe).Cells(4, 16).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 16).Interior.ColorIndex = xlNone
            End If
            If Arr(p, 19).Value = True Then
            Sheets(Mappe).Cells(4, 17).Interior.ColorIndex = Farve
                          Else
            Sheets(Mappe).Cells(4, 17).Interior.ColorIndex = xlNone
            End If
           
            Exit For
        End If
    Next p
   
Application.ScreenUpdating = True
End Sub
Avatar billede bak Forsker
03. november 2006 - 16:01 #1
måske sådan her:

Private Sub DriverName_Combo_Change()
  Dim i, o, p As Integer
  Dim Arr(3 To 150, 20) As Variant
  Mappe = "Ark1"
  ArkNavn = "Dage.xls"
  Farve = "4"                                        ' Grøn
  Application.ScreenUpdating = False

  On Error Resume Next
  Workbooks("cha.xls").Activate
  If Err.Number <> 0 Then Workbooks.Open "G:\cha.xls"
  With Sheets("Chau")
      For i = 3 To 150
        Arr(i, 0) = .Cells(i, 1).Value              'Navn
        Arr(i, 1) = .Cells(i, 2).Value              'Irl Navn
        Arr(i, 2) = .Cells(i, 36).Value              'LønNr
        Arr(i, 3) = .Cells(i, 38).Value              'Acc tillæg
        Arr(i, 4) = .Cells(i, 41).Value              'Time Løn
        Arr(i, 5) = .Cells(i, 43).Value              'Løn Kode
        'Celler "T:AG"
        For x = 6 To 19
            Arr(i, x) = .Cells(i, x + 14)
        Next
      Next i
  End With
  ActiveWorkbook.Close
  Workbooks(ArkNavn).Activate

  With Workbooks(ArkNavn).Sheets(Mappe)
      For p = 3 To 150
        If DriverName_Combo.Value = Arr(p, 0) Then

            .Cells(2, 13) = Arr(p, 1)
            .Cells(3, 14) = Arr(p, 2)
            LoenNrBox.Value = Arr(p, 2)
            .Cells(1, 25) = Arr(p, 3)
            .Cells(12, 20) = Arr(p, 4)
            .Cells(12, 22) = Arr(p, 5)

            For x = 6 To 19
              .Cells(4, x - 2).Interior.ColorIndex = xlNone
              If Not IsEmpty(Arr(p, x)) Then .Cells(4, x - 2).Interior.ColorIndex = Farve
            Next

            Exit For
        End If
      Next p
  End With

  Application.ScreenUpdating = True
End Sub
Avatar billede bak Forsker
03. november 2006 - 16:08 #2
Det skal lige siges at for mig ser det ud som du vil skrive 147 gange til række 4 og makroen er baseret på dette.
Det er muligvis ikke rigtigt, og så skal den sidste løkke ændres ti også at indeholde p

fx
For x = 6 To 19
              .Cells(p+1, x - 2).Interior.ColorIndex = xlNone
              If Not IsEmpty(Arr(p, x)) Then .Cells(p+1, x - 2).Interior.ColorIndex = Farve
            Next
Avatar billede splokit Nybegynder
03. november 2006 - 16:33 #3
Farve delen skal via det opslag på "cha.xls/Chau/"T:AG""
ovet til "D4:Q4" men kun hvis der er en værdi.
Hvis "V?" = 1 skal "D4" Blive grøn.
Avatar billede splokit Nybegynder
03. november 2006 - 16:36 #4
P er det fordi den rigtigt laver opslag på "cha.xls" men gør det fra comboboxen nu
Avatar billede bak Forsker
03. november 2006 - 16:54 #5
tjah, så skulle det jo fungere :-)
Avatar billede splokit Nybegynder
10. november 2006 - 09:11 #6
Virker ikke den laver ille noget!?
Avatar billede splokit Nybegynder
20. november 2006 - 10:14 #7
Humm..
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester