Makro - fehlerhafte Tabellenzusammenführung

Computer: Software & Programmierung Visual Basic
#1

Hallo Zusammen,

Ich arbeite mit Excel 2003 SP3 und einem Informationssystem von Trackwise. Wenn ich bestimmte Infos im Tabellenformat aus diesem System exportiere, dann bekomme ich diese Daten in zwei seperaten CSV-Tabellen. Die Daten beider Tabellen lassen sich anhand einer „PR ID“-Nummer zusammenführen. Diese ist in jeder Zeile zu finden und wenn beide Tabellen eine übereinstimmende Nummer haben werden beide Daten in einer neuen Tabelle in einer Zeile nebeneinander dargestellt. Bei „PR ID“-Nummern die 4-stellig oder kleiner sind funktioniert das Makro einwandfrei, aber sobald es 5-stellig wird werden die Daten sinnfrei untereinanderweg in der neuen Tabelle zusammengeführt. Ich habe im hier unten zusehenden Code versucht eine Einschränkung wie „kleiner gleich 4“ oder etwas ähnliches zu finden, war aber ohne Erfolg.

Kann mir jemand sagen wieso es mit den 5-stelligen „PR ID“-Nummer nicht richtig funktioniert? Vielen Dank!!! Gruß TecAttack

Sub MergeSheets()

’ opens two workbooks and merges data from the second to be opened into the first one

Application.ScreenUpdating = False

Dim Sourcefile As String 'opens sourcefile (where date are merged in)
With Application.FileDialog(msoFileDialogOpen)
.Title = „file to be merged in“
.Filters.Add „csv-file“, „*.csv“
.Show
Sourcefile = .SelectedItems(1)
End With
On Error Resume Next

Dim Gridfile As String 'opens gridfile (where date come from)
With Application.FileDialog(msoFileDialogOpen)
.Title = „file containing the grid fields“
.Filters.Add „csv-file“, „*.csv“
.Show
Gridfile = .SelectedItems(1)
End With
On Error Resume Next

'getting the filename of the gridfile-dir-string to close it later
Dim x As Variant
x = Split(Gridfile, „“)
Gridfile = x(UBound(x))

'file with data to be copied out of being opened
Workbooks.Open Filename:=Gridfile
Workbooks(Gridfile).Worksheets(1).Activate
'range to be copied will be determined
Range(„A1“, Cells(ActiveSheet.UsedRange.Rows.count, ActiveSheet.UsedRange.Columns.count)).Select
Selection.Copy

'file the date to be copied into being opened
Workbooks.Open Filename:=Sourcefile
Workbooks(Sourcefile).Activate
'data where merged into the sourcefile
Dim NewPrColumn As Integer
NewPrColumn = ActiveSheet.UsedRange.Columns.count + 1
Cells(1, NewPrColumn).Select
ActiveSheet.Paste

'now the big one: sort-algorithm

Dim i As Integer
Dim j As Integer
Dim sPrID As Integer
Dim gPrID As Integer

For i = 2 To ActiveSheet.UsedRange.Rows.count
sPrID = Cells(i, 1).Value
gPrID = Cells(i, NewPrColumn).Value
If gPrID > sPrID Then
If Not sPrID = 0 Then
Range(Cells(i, NewPrColumn), Cells(i, ActiveSheet.UsedRange.Columns.count)).Insert
End If
End If
If gPrID

#2

Kann mir jemand sagen wieso es mit den 5-stelligen „PR
ID“-Nummer nicht richtig funktioniert? Vielen Dank!!! Gruß

Hallo TecAttack,

benutze hier den Pre-tag dann sieht der Code so aus wie nachstehend.
Könnte sein, du hast nur Integer, die gehen nur bis 32xxx, nimm long.
Probier dies mal:

Option Explicit
'
Sub MergeSheets()
' opens two workbooks and merges data from the second to be opened into the first one
Dim Sourcefile As String 'opens sourcefile (where date are merged in)
Dim x As Variant
Dim dummy As String
Dim Gridfile As String 'opens gridfile (where date come from)
Dim i As Long
Dim j As Long
Dim sPrID As Long
Dim gPrID As Long
Dim NewPrColumn As Long
Dim wksG As Worksheet, wksS As Worksheet
Dim wkbG As Workbook, wkbS As Workbook
Application.ScreenUpdating = False
On Error GoTo Hell
With Application.FileDialog(msoFileDialogOpen)
 .Title = "file to be merged in"
 .Filters.Add "csv-file", "\*.csv"
 .Show
 Sourcefile = .SelectedItems(1)
End With
With Application.FileDialog(msoFileDialogOpen)
 .Title = "file containing the grid fields"
 .Filters.Add "csv-file", "\*.csv"
 .Show
 Gridfile = .SelectedItems(1)
End With
'file with data to be copied out of being opened
Workbooks.Open Filename:=Gridfile
Set wkbG = ActiveWorkbook
Set wksG = wkbG.Worksheets(1)
'range to be copied will be determined
'file the date to be copied into being opened
Workbooks.Open Filename:=Sourcefile
Set wkbS = ActiveWorkbook
Set wksS = wkbS.Worksheets(1)
With wksS
 'data where merged into the sourcefile
 wksG.Range("A1", wksG.UsedRange).Copy Destination:=.Cells(1, NewPrColumn)
 'now the big one: sort-algorithm
 For i = 2 To .UsedRange.Rows.Count
 sPrID = Cells(i, 1).Value
 gPrID = Cells(i, NewPrColumn).Value
 If gPrID \> sPrID Then
 If Not sPrID = 0 Then
 Range(Cells(i, NewPrColumn), Cells(i, ActiveSheet.UsedRange.Columns.Count)).Insert
 End If
 End If
 If gPrID 0 Then MsgBox Err.Number & Chr(10) & Err.Description
End Sub

Gruß
Reinhard