Eine Tabelle in Code einfügen
David
ich hab dieses Problem hier vor kurzem schon gepostet, aber leider keine Antwort bekommen die funktioniert hat. In dem untenstehenden Code soll eine weitere tabelle "all_data_alt" hinzugefügt werden.
Diese Tabelle soll genauso wie die jetzige Tabelle "all_data_neu" durch das Makro laufen.
Wo muss die zweite Tabelle im Code hinzugefügt werden?
Private Sub CommandButton1_Click()
Dim rng As Range, rngLoeschen As Range, StatusCalc As Long
Dim objWs As Worksheet, lngJ As Long, objWsAll As Worksheet
Dim arrWerteMaster() As String, lngIndex As Long, Spalte As Long, bLoeschen As Boolean
If Me.ComboBox1.ListIndex > -1 Then
Set rng = Sheets("Master").Range("Liste").Find(Me.ComboBox1.Text, lookat:=xlWhole)
If Not rng Is Nothing Then
If rng.Offset(0, 1) = Me.TextBox1.Text Then
intC = 0
If rng.Offset(0, 2) "" Then
'Alle Blätter außer Übersicht ausblenden
For Each objWs In Me.Parent.Worksheets
If objWs.Name "Übersicht" Then objWs.Visible = xlSheetVeryHidden
Next
'Blätter mit Zugriff für Name einblenden
For lngJ = 2 To 12
With rng.Offset(0, lngJ)
If .Text "" Then
With Sheets(.Text)
.Visible = xlSheetVisible
.Activate
End With
End If
End With
Next
Set objWsAll = Worksheets("all_data")
'Vergleichswerte aus Blatt Master einlesen
ReDim arrWerteMaster(13 To 16)
For lngIndex = 13 To 16
arrWerteMaster(lngIndex) = rng.Offset(0, lngIndex).Text
Next
With objWsAll
With Application
StatusCalc = .Calculation
If StatusCalc xlCalculationManual Then .Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.StatusBar = "Tabelle ""all_data"" wird aufbereitet"
End With
'Spaltenwerte mit Werten aus Master vergleichen
'Wenn ein Wert übereinstimmt dann wird die Zeile nicht gelöscht
For lngJ = .Cells.SpecialCells(xlCellTypeLastCell).Row To 2 Step -1
bLoeschen = True
For lngIndex = LBound(arrWerteMaster) To UBound(arrWerteMaster)
If arrWerteMaster(lngIndex) "" Then
For Spalte = 1 To 40
Select Case Spalte
Case 29, 30, 32, 33, 34 'Spalten AC,AD, AF, AG und AH
If .Cells(lngJ, Spalte).Text = arrWerteMaster(lngIndex) Then
bLoeschen = False
Exit For
End If
End Select
Next
If bLoeschen = False Then Exit For
End If
Next
If bLoeschen = True Then
If rngLoeschen Is Nothing Then
Set rngLoeschen = .Cells(lngJ, 1)
Else
Set rngLoeschen = Application.Union(rngLoeschen, .Cells(lngJ, 1))
End If
End If
Next
If Not rngLoeschen Is Nothing Then
rngLoeschen.EntireRow.Delete
End If
With Application
If StatusCalc .Calculation Then .Calculation = StatusCalc
.ScreenUpdating = False
.EnableEvents = True
.StatusBar = False
End With
End With
Else
For Each objWs In Me.Parent.Worksheets
objWs.Visible = xlSheetVisible
Next
End If
Else
intC = intC + 1
If intC Grüße,
David