Microsoft Excel

Herbers Excel/VBA-Archiv

Array Falsch?

Betrifft: Array Falsch? von: Lorenz
Geschrieben am: 03.11.2012 15:43:20

Hallo Excelianer

Ich vermute: Excelspezis können die Aufgabenstellung erkennen. Wäre mir lieber so, da meine Erklärungen immer sehr mies sind. Falls es aber doch notwendig wird, werde ich eine Erläuterung meiner Wünsche nachreichen. Ganz kurz: Zwei gleich aufgebaute Blätter und es soll wenn im 2ten Blatt ein "F" vorkommt, so soll im 1ten Blatt ein Kreuz erscheinen

Sub uebertrag()
Dim arr1, arr2
arr1 = Array(wksKalender.Range("H14:ABK97"))
arr2 = Array(wksWE_F.Range("H14:ABK97"))

With Range(arr1)
If Range(arr2) = "F" Then
    With .Borders(xlDiagonalDown)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
        With .Borders(xlDiagonalUp)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
        End With
Else
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With

End Sub

Wie gehört der Code "funktionierend" umgestrickt (Mustercode würde auch reichen)

Grüße Lorenz

  

Betrifft: umgestrickter Code von: Erich G.
Geschrieben am: 03.11.2012 16:22:51

Hi,
der folgende Code geht davon aus, dass es weniger Zellen mit "F" als ohne gibt. Sonst dauert das seeehr lange.
Im ersten Schritt werden in einem Rutsch alle Diagoalen beseitigt,
so dass dann nur noch die Zellen anzupassen sind, zu denen es ein F gibt.

Probier mal:

Option Explicit                  ' immer zu empfehlen

Sub uebertrag()
   Dim wksKalender As Worksheet, wksWE_F As Worksheet
   Dim arrF, rngKal As Range, zz As Long, ss As Long

   Set wksKalender = Worksheets(1)                    ' anpassen
   Set wksWE_F = Worksheets(2)                        ' anpassen

   arrF = wksWE_F.Range("H14:ABK97").Value      ' F-Werte in Array
   Set rngKal = wksKalender.Range("H14:ABK97")  ' Zielbereich

   rngKal.Borders(xlDiagonalDown).LineStyle = xlNone  ' Diagonalen weg
   rngKal.Borders(xlDiagonalUp).LineStyle = xlNone    ' Diagonalen weg

   For zz = 1 To UBound(arrF)                ' Zeilen
      For ss = 1 To UBound(arrF, 2)          ' Spalten
         With rngKal.Cells(zz, ss)           ' Zelle
            If arrF(zz, ss) = "F" Then
               With .Borders(xlDiagonalDown)          ' neue Diagonale
                  .LineStyle = xlContinuous
                  .Weight = xlThin
                  .ColorIndex = xlAutomatic
               End With
               With .Borders(xlDiagonalUp)
                  .LineStyle = xlContinuous
                  .Weight = xlThin
                  .ColorIndex = xlAutomatic
               End With
            End If
         End With
      Next ss
   Next zz
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: umgestrickter Code - umgeordnet von: Erich G.
Geschrieben am: 03.11.2012 16:27:06

Hi,
das With wird nur gebraucht, wenn If ... = "F" zutrifft. So ist es besser:

Sub uebertrag()
   Dim wksKalender As Worksheet, wksWE_F As Worksheet
   Dim arrF, rngKal As Range, zz As Long, ss As Long

   Set wksKalender = Worksheets(1)                    ' anpassen
   Set wksWE_F = Worksheets(2)                        ' anpassen

   arrF = wksWE_F.Range("H14:ABK97").Value      ' F-Werte in Array
   Set rngKal = wksKalender.Range("H14:ABK97")  ' Zielbereich

   rngKal.Borders(xlDiagonalDown).LineStyle = xlNone  ' Diagonalen weg
   rngKal.Borders(xlDiagonalUp).LineStyle = xlNone    ' Diagonalen weg

   For zz = 1 To UBound(arrF)                ' Zeilen
      For ss = 1 To UBound(arrF, 2)          ' Spalten
         If arrF(zz, ss) = "F" Then
            With rngKal.Cells(zz, ss)           ' Zelle
               With .Borders(xlDiagonalDown)          ' neue Diagonale
                  .LineStyle = xlContinuous
                  .Weight = xlThin
                  .ColorIndex = xlAutomatic
               End With
               With .Borders(xlDiagonalUp)
                  .LineStyle = xlContinuous
                  .Weight = xlThin
                  .ColorIndex = xlAutomatic
               End With
            End With
         End If
      Next ss
   Next zz
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: AW: umgestrickter Code - umgeordnet von: Lorenz
Geschrieben am: 03.11.2012 18:18:31

Hallo Erich

Hab beide Code ausprobiert. Beide wollen aber nicht. In wksKalender bleibt der Bestand der Diagonalen, sowie ein Neubestand aus wksWE_F wird ebenfalls in wksKalender nicht übernommen.

Grüsse
Lorenz


  

Betrifft: glaub ich nicht von: Erich G.
Geschrieben am: 03.11.2012 23:49:21

Hi Lorenz,
dass der Code keinen Effekt hervorruft, vermag ich nicht zu glauben.
Bei mir - und in dieseer BeiSpielmappe - läuft er sicher: https://www.herber.de/bbs/user/82468.xlsm

Kannst du anhand dieser Mappe klären, warum es bei dir nicht läuft?
Wenn nicht, lade bitte eine Mappe hoch, in der das Problem auftritt.

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: AW: glaub ich nicht von: Lorenz
Geschrieben am: 04.11.2012 10:44:47

Hi Erich

Bitte vielmals um Entschuldigung. Wenn man des Lesens nicht mächtig ist, passiert so etwas. Der Grund des "nicht" funktionieren war: Bei der Worksheet-Anpassung schrieb ich statt "WochenRuhe" (original Blattname), "WochenEndRuhe" hinein. (hatte im Lauf der Zeit das Blatt umbenannt, dann aber darauf vergessen). Kurz u. gut: Dein Code läuft!!!

Danke nochmal für deine Bemühung(en) & schönen Sonntag
wunscht dir Lorenz


  

Betrifft: Danke für deine Rückmeldung, auch schönen Sonntag von: Erich G.
Geschrieben am: 04.11.2012 11:06:21




 

Beiträge aus den Excel-Beispielen zum Thema "Array Falsch?"