Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1284to1288
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Array Falsch?

Array Falsch?
03.11.2012 15:43:20
Lorenz
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
umgestrickter Code
03.11.2012 16:22:51
Erich
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

Anzeige
umgestrickter Code - umgeordnet
03.11.2012 16:27:06
Erich
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

Anzeige
AW: umgestrickter Code - umgeordnet
03.11.2012 18:18:31
Lorenz
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

glaub ich nicht
03.11.2012 23:49:21
Erich
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

Anzeige
AW: glaub ich nicht
04.11.2012 10:44:47
Lorenz
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

Danke für deine Rückmeldung, auch schönen Sonntag
04.11.2012 11:06:21
Erich

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige