Brauche Hilfe mit VB für meine Warenwirtschaft

Hallo
Ich benötige als Ergänzung für meine Warenwirtschafts-software ein VB-Script für Excel.
Die Wawi spuckt mir nämlich csv Dateien aus, von den Verkäufen eines bestimmten Zeitraums.
Ich muss in dieser csv dann nach einem Begriff suchen, um mir anzeigen zu lassen, welche Artikel mit diesem Suchbegriff verkauft wurden.
Da ich alle Bilder von den Artikeln auf meinem Server habe, könnte man eventuell ein Bild dynamisch erzeugen lassen in einer Zelle.
Ich habe mir das folgendermaßen vorgestellt:
Ich benötige ein VB Script für Excel, welches alle Zellen löscht in der Mappe, in denen nicht ein ganz bestimmtes Suchwort enthalten ist.
Also wenn in allen Zellen "666" steht bis auf in Zelle B1 "tulpe" und in B22 "tulpenform", soll das Makro alle Zellen löschen außer B1 und B22, sofern das Suchwort "tulpe" eingegeben wurde.
Bei den Zellen, die nicht gelöscht wurden, also in den Zellen, in denen das Suchwort enthalten ist, soll die Linke Zelle (also die dementsprechende Zeile der A Spalte) nicht gelöscht werden.
Am Ende sollen ergo nurnoch die Zellen mit den Suchwörtern und die links dazugehörige Zelle übrig bleiben. In meinem Beispiel soll also übrig bleiben: A1 und B1, genau wie A22 und B22.
Wenn diese Berechnung abgeschlossen wurde, soll rechts von der Zelle mit dem enthaltenen Suchwort ein Bild sichtbar werden.
Die URL des Bildes setzt sich aus einem vorgegebenen Pfad und der linken Zeile der A-Spalte zusammen, die ja nicht gelöscht werden soll, sofern rechts von ihr die Zelle mit dem richtigen Suchwort vorhanden ist.
Der Pfad der Bilddatei soll sich dann folgendermaßen berechnen: http://www.testurl.de/pics/artikel--hier der Wert von der linken Spalte--/small.jpg
In unserem Beispiel also http://www.testurl.de/pics/artikel666/small.jpg
-------
Das würde mir helfen, schneller nachzuvollziehen, welche Artikel ich von einer bestimmten Sorte verkauft habe und sehe dann auch
noch das Bild. Das wäre ein riesiger Schritt vorwärts im Workflow für mich.
Ist sowas möglich? Wäre jemand bereit mir damit zu helfen? :)
Gruß - Ben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Ben,
hier ein entsprechendes Makro.
LG
Franz

Sub SucheArtikel()
Dim varSuche
Dim wks As Worksheet
Dim Zelle As Range
Dim Zeile1 As Long, Zeile2 As Long, Spalte As Long
Dim str1stAddress As String, bolLoeschen As Boolean
Dim objShape As Shape, strDatei As String
On Error GoTo Fehler
varSuche = InputBox("Suchbegriff:", "Artikelsuchen")
If varSuche = "" Then Exit Sub
Set wks = ActiveSheet
Zeile1 = 1
Application.ScreenUpdating = False
With wks
Set Zelle = .Cells.Find(After:=.Cells.SpecialCells(xlCellTypeLastCell), _
What:=varSuche, LookIn:=xlValues, lookat:=xlPart, _
searchorder:=xlByRows, searchdirection:=xlNext)
If Not Zelle Is Nothing Then
str1stAddress = Zelle.Address
'Inhalte in Zeilen ohne Suchbegriff löschen
Do
Zeile2 = Zelle.Row
If Zeile2 = Zeile1 Then
'do nothing
Zeile1 = Zeile2 + 1
Else
If Zeile2 - Zeile1 > 1 Then
.Range(.Rows(Zeile1), .Rows(Zeile2 - 1)).Clear
bolLoeschen = True
Zeile1 = Zeile2 + 1
Else
Zeile1 = Zeile2 + 1
End If
End If
Set Zelle = .Cells.FindNext(After:=Zelle)
If Zelle Is Nothing Then Exit Do
If Zelle.Address = str1stAddress Then
Zeile2 = .Cells(.Rows.Count, 1).End(xlUp).Row
If Zeile2 >= Zeile1 Then
.Range(.Rows(Zeile1), .Rows(Zeile2)).Clear
bolLoeschen = True
End If
Exit Do
End If
Loop
'Leere zeilen löschen, wennZellen in Spalte A leer
If bolLoeschen = True Then
.Range(.Cells(1, 1), .Cells(Zeile2, 1)).SpecialCells(xlCellTypeBlanks) _
.EntireRow.Delete shift:=xlShiftUp
End If
'Zellen ohne Suchbegriff rechts von Spalte A löschen und Zellen nach  _
linksverschieben
Application.ScreenUpdating = True
Zeile2 = .Cells(.Rows.Count, 1).End(xlUp).Row
For Zeile1 = 1 To Zeile2
For Spalte = .Cells(Zeile1, .Columns.Count).End(xlToLeft).Column To 2 Step -1
If InStr(1, .Cells(Zeile1, Spalte).Text, varSuche) = 0 Then
.Cells(Zeile1, Spalte).Delete shift:=xlShiftToLeft
End If
Next
Next
'Zeilenhöhe für Bilder anpassen
.Range(.Rows(1), .Rows(Zeile2)).RowHeight = 100 'Zeilenhöhe für Bilder
Spalte = 3 'Spalte in der die Bilder eingefügt werden sollen
For Zeile1 = 1 To Zeile2
'Einfügezelle selektieren
.Cells(Zeile1, Spalte).Select
'Name Grafikdatei -ggf. anpassen
strDatei = "http://www.testurl.de/pics/artikel" _
& .Cells(Zeile1, 1).Text & "/small.jpg"
'Bild einfügen und Höhe/Position anpassen
.Pictures.Insert strDatei
Set objShape = .Shapes(.Shapes.Count)
With objShape
.LockAspectRatio = msoTrue
.Height = 96
.Top = wks.Cells(Zeile1, 3).Top + 2
.Left = wks.Cells(Zeile1, 3).Left + 2
End With
NextArtikel:
Next
Else
MsgBox "Suchbegriff nicht gefunden"
End If
End With
Fehler:
'Fehlerbehandlung, z.B wenn das Bild nicht gefunden wird.
With Err
Select Case .Number
Case 0 'Alles OK
Case 1004
Resume NextArtikel
Case Else
MsgBox "Fehler-nr.; " & .Number & vbLf & .Description
End Select
End With
Application.ScreenUpdating = True
End Sub

'Zellen ohne Suchbegriff rechts von Spalte A löschen und Zellen nach _ linksverschieben Application.ScreenUpdating = True Zeile2 = .Cells(.Rows.Count, 1).End(xlUp).Row varSuche = LCase(varSuche) For Zeile1 = 1 To Zeile2 For Spalte = .Cells(Zeile1, .Columns.Count).End(xlToLeft).Column To 2 Step -1 If InStr(1, LCase(.Cells(Zeile1, Spalte).Text), varSuche) = 0 Then .Cells(Zeile1, Spalte).Delete shift:=xlShiftToLeft End If Next Next

Beliebteste Forumthreads (12 Monate)

Brauche Hilfe mit VB für meine Warenwirtschaft

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Brauche Hilfe mit VB für meine Warenwirtschaft

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread