Option Explicit
Public AnzahlZeilenImport As Long
Public AnzahlZeilenExport As Long
Public AnzahlHersteller As Integer
Public CounterImport As Long
Public CounterExport As Long
Public CounterHersteller As Integer
Public TempImportString As String
Public TempExportString As String
Public SuchPos As Integer
Public Hersteller() As String
Public HerstellerStr As String
Public HerstellerNeuStr As String
Public PartNrStr As String
Public PartNrAStr As String
Public PartNrBStr As String
Public BezeichnungStr As String
Public BezeichnungVorStr As String
Public AbbruchTaste As Boolean
Public StartBearbeitung As Long
Const HerstellerStart = 4
Const HerstellerSpalte = "G"
Const PartNrSpalte = "F"
Const BezeichnungSpalte = "E"
Const AbbruchString = "##"
Const RohDatenSpalte = "H"
Public Sub Import_SMA_Variante_1()
HerstellerStr = "Hersteller"
VariablenEinlesen
Sheets("Export").Select
Sheets("Export").Columns("A:A").ColumnWidth = 18
If Sheets("Export").Range("E1").Text = "Bezeichnung" Then
Else
Sheets("Export").Columns("E:E").Insert Shift:=xlToRight
Sheets("Export").Range("E1") = "Bezeichnung"
End If
SMA_Import.Show
Sheets("Export").Select
Range("C2").Select
ActiveWindow.FreezePanes = True
End Sub
Public Function VariablenEinlesen()
AnzahlZeilenImport = WorksheetFunction.CountA(Sheets("Import").Range("A:A"))
AbbruchTaste = False
StartBearbeitung = 2
AnzahlZeilenExport = WorksheetFunction.CountA(Sheets("Export").Range("A:A"))
CounterExport = WorksheetFunction.CountA(Sheets("Export").Range("A:A"))
If CounterExport >= 1 Then SMA_Import.Import1Erl = True
End Function
Public Function DatenImportierenKnopf()
If SMA_Import.Import1Erl Then
If MsgBox("Es sind schon Daten vorhanden. Diese überschreiben?", vbYesNo) = vbYes Then
DatenImportieren
SortierungEintragen
End If
Else
DatenImportieren
SortierungEintragen
End If
SMA_Import.Import1Erl = True
End Function
Public Function DatenSelektierenKnopf()
AnzahlHersteller = HerstellerEinlesen
StartBearbeitung = InputBox("Bitte Startzeile eingeben " & vbCrLf, "Startzeile", StartBearbeitung)
If StartBearbeitung < 2 Then StartBearbeitung = 2
For CounterImport = StartBearbeitung To AnzahlZeilenExport
TempImportString = Sheets("Export").Range(RohDatenSpalte & CounterImport)
Application.ScreenUpdating = True
Application.Goto Range("A" & CounterImport - 1), True
Rows(CounterImport).Select
HerstellerSuchen
PartNrSelektieren
If AbbruchTaste Then GoTo AbbruchHerstellerSuchen
Next
AbbruchHerstellerSuchen:
End Function
Public Function DatenImportieren()
Sheets("Export").UsedRange.ClearContents
Sheets("Export").Rows(1).Value = Sheets("Import").Rows(1).Value
AnzahlZeilenExport = 2
CounterExport = 2
For CounterImport = 2 To AnzahlZeilenImport
TempImportString = Sheets("Import").Range("F" & CounterImport).Value
SuchPos = InStr(1, TempImportString, " oder ", 1)
If SuchPos = 0 Then
Sheets("Export").Rows(CounterExport).Value = Sheets("Import").Rows(CounterImport).Value
Else
Sheets("Export").Rows(CounterExport).Value = Sheets("Import").Rows(CounterImport).Value
Sheets("Export").Range("F" & CounterExport).Value = Left(TempImportString, SuchPos)
Do While SuchPos > 0
CounterExport = CounterExport + 1
Sheets("Export").Rows(CounterExport).Value = Sheets("Import").Rows(CounterImport).Value
TempImportString = Right(TempImportString, Len(TempImportString) - SuchPos)
SuchPos = InStr(2, TempImportString, "oder", 1) - 1
If SuchPos > 0 Then
Sheets("Export").Range("F" & CounterExport).Value = Left(TempImportString, SuchPos)
Else
Sheets("Export").Range("F" & CounterExport).Value = TempImportString
End If
Loop
End If
CounterExport = CounterExport + 1
Next
Sheets("Export").Columns("A:A").Insert Shift:=xlToRight
End Function
Public Function SortierungEintragen()
Sheets("Export").Range("A1").Value = "Sortierung"
AnzahlZeilenExport = CounterExport
For CounterExport = 2 To AnzahlZeilenExport
Sheets("Export").Range("A" & CounterExport).Value = CounterExport - 1
Next
Sheets("Export").Select
Sheets("Export").Columns("A:A").HorizontalAlignment = xlCenter
Sheets("Export").Columns("A:A").ColumnWidth = 18
Sheets("Export").Columns("F:G").EntireColumn.AutoFit
Sheets("Export").Columns("F:G").HorizontalAlignment = xlLeft
End Function
Public Function HerstellerSuchen()
SuchPos = 0
CounterHersteller = 0
Do
CounterHersteller = CounterHersteller + 1
SuchPos = InStr(1, TempImportString, Hersteller(CounterHersteller), 1)
Loop Until SuchPos > 1 Or CounterHersteller > AnzahlHersteller
If SuchPos > 0 And Len(Hersteller(CounterHersteller)) > 0 Then
Sheets("Export").Range(HerstellerSpalte & CounterImport) = Hersteller(CounterHersteller)
Else
HerstellerNichtGefunden
CounterHersteller = CounterHersteller - 1
Sheets("Export").Range(HerstellerSpalte & CounterImport) = HerstellerStr
SuchPos = InStr(1, TempImportString, Hersteller(CounterHersteller), 1)
End If
End Function
Public Function HerstellerNichtGefunden()
CounterHersteller = WorksheetFunction.CountA(Sheets("Start").Range("A:A"))
HerstellerStr = InputBox("Der Hersteller kann nicht gefunden werden. Bitte löschen Sie alle unnötigen Zeichen", "Erstellung eines neuen Herstellers - Abbruich mit ##", TempImportString)
If HerstellerStr = AbbruchString Then
AbbruchTaste = True
Else
Hersteller(AnzahlHersteller) = HerstellerStr
AnzahlHersteller = AnzahlHersteller + 1
ReDim Preserve Hersteller(1 To AnzahlHersteller + 1)
Sheets("Start").Range("A" & CounterHersteller + HerstellerStart) = Trim(HerstellerStr)
End If
AnzahlHersteller = HerstellerEinlesen
End Function
Public Function PartNrSelektieren()
If SuchPos <= 0 Then SuchPos = 1
If Sheets("Export").Range(PartNrSpalte & CounterImport) = "" Then
PartNrStr = Left(TempImportString, SuchPos - 1)
Else
PartNrStr = Sheets("Export").Range(PartNrSpalte & CounterImport)
End If
If Sheets("Export").Range(BezeichnungSpalte & CounterImport) = "" Then
BezeichnungStr = Right(TempImportString, (Len(TempImportString) - (Len((Hersteller(CounterHersteller))) + SuchPos - 1)))
Else
BezeichnungStr = Sheets("Export").Range(BezeichnungSpalte & CounterImport)
End If
If CounterImport <= 2 Then
BezeichnungVorStr = ""
Else
BezeichnungVorStr = Sheets("Export").Range(BezeichnungSpalte & CounterImport - 1)
End If
DatenSelektierenBox
If AbbruchTaste Then
Else
Sheets("Export").Range(HerstellerSpalte & CounterHersteller + HerstellerStart) = HerstellerNeuStr
If HerstellerNeuStr = HerstellerStr Then
Else
AnzahlHersteller = AnzahlHersteller + 1
ReDim Preserve Hersteller(1 To AnzahlHersteller + 1)
Sheets("Start").Range("A" & CounterHersteller + HerstellerStart) = Trim(HerstellerStr)
AnzahlHersteller = HerstellerEinlesen
End If
Sheets("Export").Range(PartNrSpalte & CounterImport) = PartNrStr
Sheets("Export").Range(BezeichnungSpalte & CounterImport) = BezeichnungStr
End If
End Function
Public Function DatenSelektierenBox()
DatenSelektieren.Rohdaten = Trim(TempImportString)
DatenSelektieren.ErkannterHersteller = Trim(Hersteller(CounterHersteller))
DatenSelektieren.ErkanntePartNr = Trim(PartNrStr)
DatenSelektieren.ErkannteBezeichnung = Trim(BezeichnungStr)
DatenSelektieren.BezeichnungLetzterEintrag = BezeichnungVorStr
DatenSelektieren.Show
End Function
Public Function HerstellerEinlesen()
AnzahlHersteller = WorksheetFunction.CountA(Sheets("Start").Range("A:A"))
ActiveWorkbook.Worksheets("Start").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Start").AutoFilter.Sort.SortFields.Add Key:=Range("A4:A" & AnzahlHersteller + 10), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Start").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ReDim Preserve Hersteller(1 To AnzahlHersteller + 1)
For CounterHersteller = 1 To AnzahlHersteller
Hersteller(CounterHersteller) = Sheets("Start").Range("A" & CounterHersteller + 4)
Next
HerstellerEinlesen = AnzahlHersteller
End Function