Hier habe ich ein script, mit hilfe dessen ich eine Tabellen in meinem Workbook ergenzen kann.
Jedoch ist da irgendwo ein Fehler, da er mir nur die ersten 2 werte aus der ersten schleife richtig macht und dannach löscht er mir alle werte in der alten tabelle
hier mein Script:
Für weitere Fragen stehe ich offen...
Private Sub btn_updateFor_Click()
Dim fnamefor, dateup, cellnew, cellold, fnam As Variant
Dim dateiname As String
Dim lRF%, lRSS%
Dim counterneu, counteralt, add1, anzahl, zeile As Integer
Dim check As Boolean
Dim LoLetzte As Long
Dim x As Range, oRange As Range
check = False
zeile = 2
counterneu = 1
counteralt = 1
anzahl = 0
dateup = Date
fnamefor = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If fnamefor = False Then
MsgBox "NO File specified"
Exit Sub
Else
Workbooks.Open (fnamefor)
Set fnam = CreateObject("Scripting.FileSystemObject")
dateiname = fnam.getfilename(fnamefor)
If dateiname = "" Then
Exit Sub
Else
MsgBox dateiname
If [A65536] = "" Then
LoLetzte = [A65536].End(xlUp).row
Else
LoLetzte = 65536
End If
Set x = Workbooks(dateiname).Worksheets("sheet1") _
.Range(Cells(1, 1), Cells(LoLetzte, 1))
On Error GoTo ende1
Set oRange = x.SpecialCells(xlCellTypeBlanks)
oRange.EntireRow.Delete
ende1:
lRSS = tbl_forwarder.Cells(Rows.Count, 1).End(xlUp).row
lRF = Workbooks(dateiname).Worksheets("sheet1") _
.Cells(Rows.Count, 1).End(xlUp).row
MsgBox ("Die anzahl der bestezten zeilene in der neuen mappe " & _
lRF & Chr(13) & lRSS)
Do Until counterneu > lRF
Do Until counteralt > lRSS
cellnew = Worksheets("sheet1").Cells(counterneu, 1).Value
cellold = tbl_forwarder.Cells(counteralt, 1).Value
If cellnew = cellold Then
check = True
anzahl = anzahl + 1
If anzahl > 1 Then
tbl_forwarder.Cells(counteralt, 1).Value = ""
anzahl = 1
If counteralt = lRSS Then
counterneu = counterneu + 1
check = False
'lRSS = tbl_forwarder.Cells(Rows.Count, 1).End(xlUp).row
counteralt = 1
anzahl = 0
Else
counteralt = counteralt + 1
End If
Else
If counteralt = lRSS Then
counterneu = counterneu + 1
check = True
'lRSS = tbl_forwarder.Cells(Rows.Count, 1).End(xlUp).row
counteralt = 1
anzahl = 0
Else
counteralt = counteralt + 1
End If
End If
'counteralt = counteralt + 1
'counteralt = counteralt - 1
Else
If counteralt > lRSS And check = False Then
add1 = lRSS + 1
zeile = zeile + 1
tbl_forwarder.Cells(add1, 1).Value = cellnew
tbl_storage.Cells(zeile, 5).Value = cellnew
lRSS = tbl_forwarder.Cells(Rows.Count, 1).End(xlUp).row
MsgBox "New entry: " & cellnew
counterneu = counterneu + 1
counteralt = 1
Else
counteralt = counteralt + 1
End If
End If
Loop
counteralt = 1
counterneu = counterneu + 1
Loop
tbl_forwarder.Cells(2, 4).Value = Date
Do Until zeile = 200
zeile = zeile + 1
tbl_storage.Cells(zeile, 5).Value = ""
Loop
zeile = zeile - 202
MsgBox zeile & "Have been added"
End If
End If
End Sub
gruß darius