Hallo VBA-Experten
ich versuche mal mein Glück bei Euch
Ich arbeite seit langem an einer Datei mit drei Arbeitsblättern und in jedem Arbeitsblatt befindet sich eine Tabelle und ich habe verschiedene Codes geschrieben, die auch funktionieren, wie ich es möchte. Leider heißt es nun, dass die Tabellen neue Spalten in der Zukunft bekommen könnten und da liegt mein Problem. Die Codes, die ich geschrieben habe, beziehen sich auf bestimmte Spalten oder Ranges der Tabellen. D.h. wenn man neue Spalten in die Tabellen hinzufügen würde, würden meine Codes sehr wahrscheinlich nicht mehr funktionieren.
Ich habe bei verschiedenen Forums gelesen, dass man die Spalten/Ranges benennen kann und so würden neue Spalten meinen Code nicht kaputt machen. Leider blicke ich nicht mehr durch und die Umsetzung funktioniert irgendwie nicht.
Die Datei darf ich allerdings nicht hochladen.
Die Frage an Euch wäre: Wie könnte ich folgende Teile meiner Codes (rot markiert) umbenennen, damit meine Codes weiter funktionieren, wenn es neue Spalten gäbe? Hier sind meine Codes natürlich nicht komplett geschrieben. Die Teile habe ich aus den Codes rauskopiert. Ich wäre sehr dankbar für jede Hilfe oder Idee!
Beim ersten Code:With wsfirsttable
Set rngolddata = .Range(
"A4:I" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
With wssecondtable
Set rngnewdata = .Range(
"A4:I" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
With wsfirsttable.Sort
.SortFields.Clear
.SortFields.Add Key:=wsfirsttable.
Range("A4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rngolddata
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim columns
columns = Array("B", "C", "D", "E", "F", "G", "H", "I")
For j = 1 To 8n = j + 1
vout = CStr(n)
rngnewdata.Offset(1, rngnewdata.columns.Count + j).Resize(rngnewdata.Rows.Count - 1, 1).FormulaLocal = _
"=WENN($J5<>0;" + columns(j - 1) + "5=SVERWEIS(A5;" & wsfirsttable.Name & "!" & rngolddata.Address & ";" + vout + ";WAHR);"""")"
Next j
wssecondtable.AutoFilter = False
With rngnewdata
For x = 11 To 18
n = x - 9
.AutoFilter field:=x, Criteria1:="FALSCH" For Each rnghit In .Offset(1, 0).Resize(.Rows.Count - 1, .columns.Count).SpecialCells(xlCellTypeVisible)
If rnghit.Column = n Then rnghit.Interior.Color = vbRed
Next rnghit
Next x
End With
wssecondtable.AutoFilterMode = False
With rngnewdata
.AutoFilter field:=
10, Criteria1:="0"
For Each rnghit In .Offset(1, 0).Resize(.Rows.Count - 1, .columns.Count).SpecialCells(xlCellTypeVisible)
If rnghit.Column <
10 Then rnghit.Interior.Color = vbRed
Next
End With
With wssecondtable
.AutoFilterMode = False
For i = 10 To 18
.columns(i).ClearContents
Next i End With
Beim zweiten Code: With wsfirsttable
Set rngolddata = .Range("A4:I" & .Cells(.Rows.Count, 1).End(xlUp).Row)
Set rngnewdata = .Range("J5:P" & .Cells(.Rows.Count, 1).End(xlUp).Row)
Set x = .Range(Cells(R, 1), Cells(R, 16)) End With
For R = 5 To 1000
Blue = RGB(188, 255, 255)
V = Cells(R, 4).Value If InStr(V, "Closed") Then
x.Interior.Color = RGB(194, 194, 194)
ElseIf InStr(V, "progress") > 0 Or InStr(V, "approval") > 0 _
Or InStr(V, "Fulfillment") > 0 Or InStr(V, "Open") > 0 Then
x.Interior.Color = Blue
End If
With Sheets("firsttable").Range("
A5:P" & lRow).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
For Row = MaxRow To 5 Step -1
If .Cells(Row,
4).Value = "Closed" And CurrentDate1 > .Cells(Row,
6).Value Then
.Rows(Row).Delete
ElseIf .Cells(Row,
1).Value = "" Then
.Rows(Row).Delete
n = n + 1
End If
Next Row
Beim dritten Code:With wsthirdtable
Set rngolddata = .Range("
J5:P" & .Cells(.Rows.Count, 1).End(xlUp).Row)
rngolddata.Select
Selection.NumberFormat = "0"
End With
Ich bedanke mich schon im Voraus!
Menü
An- und Abmelden
Partner / Links
