VBA mit Excel - Zeile suchen und auslesen

[Geldmann3]

Hallo Leute,

Ich arbeite gerade an einem Projekt mit VBA. Es gibt ein Suchformular in welches man die ID eines Produktes eintragen kann, (die sich immer in Spalte 2 der Tabelle befindet und verglichen werden soll) anschließend sollen die Zellen der Zeile in welcher sich die richtige ID befindet einzeln in Textboxen ausgegeben werden.


Zu diesem Zweck habe ich mich schon mal an einem Mini-Suchalgorithmus (https://www.google.de/search?safe=off&client=firefox-a&hs=TkH&rls=org.mozilla:de:official&q=Suchalgorithmus&spell=1&sa=X&ei=Jmp2UZmUN8PRtAbC6YHABw&ved=0CC8QvwUoAA&biw=1280&bih=943) versucht.

Private Sub icalad_Click()

tabelle.Activate
Dim intRow As Integer
For intRow = 1 To [Bis zum Tabellenende]
If IDTextbox.Text = cell(intRow, 2).Text Then
artbe.Text = cell(intRow, 1).Text (Hier soll die dazu passende Artikelbeschreibung in die Textbox eingelesen werden)
exit for
End If
Next intRow
End Sub

So funktioniert das leider nicht.

Sub or Function not defined



Jemand einen Tipp?

[Gast]

Private Sub icalad_Click()

Dim intRow As Integer

Worksheets("tabelle").Activate

For intRow = 1 To Cells.SpecialCells.xlCellTypeLastCell.row
If IDTextbox.Text = cell(intRow, 2).Text Then
artbe.Text = cell(intRow, 1).Text (Hier soll die dazu passende Artikelbeschreibung in die Textbox eingelesen werden)
exit for
End If
Next intRow
End Sub


Statt mit Cells.SpecialCells.xlCellTypeLastCell.row die letzte benutzte Zelle in deiner Tabelle anzusprechen, was ja nicht immer dem gewünschten Verhalten entspricht, kannst du eine Schleife verwenden, die die Anzal der verwendeten Zeilen zählt.

Range("A2").Select
Zeilenzahl = Selection.CurrentRegion.Rows.Count

[Geldmann3]

Stimmt, ist sicher hilfreich. Leider bekomme ich beim Klick auf den Button weiterhin eine Fehlermeldung

Compile error:
Argument not optional


Der aktuelle Quelltext sieht jetzt so aus:
Private Sub icalad_Click()

Dim intRow As Integer

Worksheets("tabelleica").Activate
For intRow = 1 To Cells.SpecialCells.xlCellTypeLastCell.Row
If artnr.Text = cell(intRow, 2).Text Then
artbe.Text = cell(intRow, 1).Text
Exit For
End If
Next intRow

End Sub

[Rockhount]

cell(intRow, 2).Text
=> müsste imo Cells(intRow,2).Text lauten
wobei ich nicht weiss, ob .Text funktioniert oder Du .Value nehmen musst.

[Hamster]

Als Anregung, sollte funktionieren. Ggf. Userform & Tabellennamen anpassen.

Eine Rückmeldung wäre schön, obs geklappt hat.

Sub start()
UserForm1.Show
End Sub

Function icalad_click()

Dim intRow As Integer

For intRow = 1 To Tabelle1.UsedRange.Rows.Count Step 1

If UserForm1.artnr.Text = Tabelle1.Cells(intRow, 2).Value Then
UserForm1.artbe.Text = Tabelle1.Cells(intRow, 1).Value
Exit For
End If
Next

End Function

In der Userform steht folgendes wenn du auf den Button drückst:

Private Sub CommandButton1_Click()
Application.Run icalad_click
End Sub

Du kannst natürlich obigen Code direkt als Private Sub beim Drücken des Buttons ausführen. Da ich allerdings dein Programm drumherum nicht kenne, habe ich nur mal auf die schnelle etwas funktionsfähiges nachgebildet.

[Geldmann3]

Danke, funktioniert. Hat mir sehr weiter-geholfen.

Bin daran fast schon verzweifelt, hast dir n' Bier verdient :wink:
:ubeer:

[Geldmann3]

Haben nun folgendes Problem, wie können wir von einem
Workbook -> Worksheet in ein Anderes schreiben haben diesen Code zur Zeit:

Dim lngRow As Long
Dim intAnza As Integer
Dim objBuch As Excel.Application
Dim objbuchtab As Worksheet
Dim objtabica As Worksheet
Dim objWaren As New Excel.Application


objBuch.Workbooks.Open ("C:\Warenkorb\Buchungsliste.xls")
Set objbuchtab = objBuch.Sheets("Buchungsliste")
objBuch.EnableEvents = False
objBuch.DisplayAlerts = False

objWaren.Workbooks.Open ("C:\Users\DBElite\Desktop\Warenkorb\Warenkorb ICA und H&W.xlsm")
Set objtabica = objWaren.Sheets("ICA")
objWaren.EnableEvents = False
objWaren.DisplayAlerts = False



For lngRow = 1 To objtabica.UsedRange.Rows.Count Step 1


objBuch.Workbooks.Open "C:\Users\DBElite\AppData\Local\VirtualStore\Buchungsliste.xlsm"

Set objbuchtab = objBuch.Sheets("Buchungsliste")
objBuch.EnableEvents = False
objBuch.DisplayAlerts = False

objWaren.Workbooks.Open "C:\Users\DBElite\Desktop\Warenkorb\Warenkorb ICA und H&W.xlsm"
Set objtabica = objWaren.Sheets("ICA")
objWaren.EnableEvents = False
objWaren.DisplayAlerts = False



If icaeinsc.icascan.Text = objtabica.Cells(lngRow, 2).Value Then


intAnza = CInt(objtabica.Cells(lngRow, 6).Value)
If intAnza = 0 Then

MsgBox ("Der Artikel ist nicht vorhanden")

objBuch.ActiveWorkbook.SaveAs ("C:\Users\DBElite\AppData\Local\VirtualStore\Buchungsliste.xls")
objBuch.ActiveWorkbook.Close savechanges:=False
objWaren.Quit
objBuch.Quit

Exit For

Else


objbuchtab.Cells(1, 1).End(xlDown).Offset(1, 0) = objtabica.Cells(lngRow, 1).Value
objbuchtab.Cells(1, 1).End(xlDown).Offset(0, 1) = objtabica.Cells(lngRow, 2).Value
objbuchtab.Cells(1, 1).End(xlDown).Offset(0, 2) = objtabica.Cells(lngRow, 3).Value
objbuchtab.Cells(1, 1).End(xlDown).Offset(0, 3) = objtabica.Cells(lngRow, 4).Value
objbuchtab.Cells(1, 1).End(xlDown).Offset(0, 4) = objtabica.Cells(lngRow, 5).Value
objbuchtab.Cells(1, 1).End(xlDown).Offset(0, 5) = objtabica.Cells(lngRow, 6).Value
objbuchtab.Cells(1, 1).End(xlDown).Offset(0, 6) = objtabica.Cells(lngRow, 7).Value
objbuchtab.Cells(1, 1).End(xlDown).Offset(0, 7) = objtabica.Cells(lngRow, 8).Value

intAnza = -1

objtabica.Cells(lngRow, 6).Value = intAnza
objBuch.ActiveWorkbook.SaveAs ("C:\Users\DBElite\AppData\Local\VirtualStore\Buchungsliste.xls")
objBuch.ActiveWorkbook.Close savechanges:=False
objWaren.Quit
objBuch.Quit
End If

Exit For


End If

Next

End Sub

[Rockhount]

Ich werd daraus irgendwie nicht 100% schlau.
Was willst Du machen?
Von wo nach wo kopieren?
Welche Fehler bekommst Du?


1.WB als "Variablen" initialisieren...funktioniert das so wie Du es gemacht hast? Ich würds so machen:

Dim wb1, wb2 As Workbook
Dim ws1, ws2 As Worksheet

Workbooks.Open ("C:\Warenkorb\Buchungsliste.xls")
Set wb1 = Workbooks("Buchungsliste.xls")
Set ws1 = wb1.Sheets("Buchungsliste")
ws1.EnableEvents = False
ws1.DisplayAlerts = False

Workbooks.Open ("C:\Users\DBElite\Desktop\Warenkorb\Warenkorb ICA und H&W.xlsm")
Set wb2 = Workbooks("Warenkorb ICA und H&W.xlsm")
Set ws2 = wb1.Sheets("ICA")
ws2.EnableEvents = False
ws2.DisplayAlerts = False


In Deinem Code werden beide Bücher später nochmal geöffnet ohne vorher geschlossen worden zu sein...ist das gewollt?


2.Das dürfte nicht funktionieren:

objbuchtab.Cells(1, 1).End(xlDown).Offset(1, 0) = objtabica.Cells(lngRow, 1).Value

Vorausgesetzt Du willst von objbuchtab nach objtabica kopieren, dann probier mal:

objtabica.Cells(lngRow, 1).FormulaR1C1 = objbuchtab.Cells(1, 1).End(xlDown).Offset(1, 0).Value


3.Die hier hast Du nicht erstellt:

objWaren.Quit
objBuch.Quit

Wo kommen die her?

[Hamster]

Ich werde ebenfalls nicht schlau daraus.

Was genau willst du machen? Schreib doch bitte noch ein bisschen Prosa dazu, damit dein Anliegen verständlicher wird :)

[Geldmann3]

Also es geht darum das ich versuchen möchte von der einen Tabelle in die andere schreiben möchte und zwar ans ende der letzteren Tabelle in dem Fall:

von objtabica nach letzte Zeile objbuchtab

[Rockhount]

Also es geht darum das ich versuchen möchte von der einen Tabelle in die andere schreiben möchte und zwar ans ende der letzteren Tabelle in dem Fall:

von objtabica nach letzte Zeile objbuchtab

Und welche Fehlermeldung kommt da?
Du musst schon ein paar Infos rausrücken, sonst ist es schwer, Dir zu helfen.

Vielleicht kannst Du Deinen Code auch mal entsprechend kommentieren (sehr sinnvoll, wenn jemand anderes als Du den Code nachvollziehen können muss) ;)

[Geldmann3]

Danke hat sich erledigt

[Rockhount]

Danke hat sich erledigt

Kannst Du vielleicht die Lösung posten, damit andere auch was davon haben?

[Geldmann3]

Ok dann ma die Lösung
Private Sub icabestsc_Click()

'Variablen Deklarieren
Dim strmatnr, strartbez As String
Dim lngRow As Long
Dim varAnza As Variant
Dim objBuch, objWaren As Workbook
Dim objbuchtab, objtabica As Worksheet

'Öffnen des noch nicht geöffnetem Workbook
Workbooks.Open ("C:\Warenkorb\Buchungsliste.xls")

'Workbooks und Sheets zuweisen
Set objBuch = Workbooks("Buchungsliste.xls")
Set objbuchtab = objBuch.Sheets("Buchungsliste")
Set objWaren = Workbooks("Warenkorb ICA und H&W.xlsm")
Set objtabica = objWaren.Sheets("ICA")


'Kopfgesteuerte Zählerschleife
For lngRow = 1 To objtabica.UsedRange.Rows.Count Step 1

'Vergleichen von Eingabe und der Zelle
If icaeinsc.icascan.Text = objtabica.Cells(lngRow, 2).Value Then

'Einlesen der Stückzahl
varAnza = objtabica.Cells(lngRow, 6).Value

If varAnza = "0" Then

MsgBox ("Der Artikel ist nicht vorhanden")

Exit For

Else

'Tabelle 1 aktivieren
objtabica.Activate
cells(1, 1).Activate

'Gewünschte Informationen auslesen
strmatnr = objtabica.Cells(lngRow, 2).Value
strartbez = objtabica.Cells(lngRow, 1).Value

'Ziel Tabelle auswählen
objbuchtab.Activate
Cells(1, 1).Activate


'in Zieltabelle ans Ende der Tabelle Schreiben
Cells(1, 1).End(xlDown).Offset(1, 0) = strartbez
Cells(1, 1).End(xlDown).Offset(0, 1) = strmatnr
Cells(1, 1).End(xlDown).Offset(0, 2) = icainstandaus.icainstnra.Text
Cells(1, 1).End(xlDown).Offset(0, 3) = icainstandaus.icakurzau.Text
Cells(1, 1).End(xlDown).Offset(0, 4) = Date
Cells(1, 1).End(xlDown).Offset(0, 5) = "Ausgebucht"


'Wieder die Quelltabelle öffnen
objtabica.Activate

'Stückzahlwert um 1 verringern
varAnza = objtabica.Cells(lngRow, 6).Value
objtabica.Cells(lngRow, 6).Value = varAnza - 1

End If

Exit For

End If

Next

End Sub


Nochmal Danke für eure Hilfe falls was ist melde ich mich nochmal :smile:

[Rockhount]

Danke Dir :D