Hallo liebe VBA-Mitstreiter,


ich bin gerade dabei für den Job eine Herstellerdatenbank zu programmieren. An dem letzten Schritt (siehe Murphy's Law :)) haperts allerdings. Wenn ich eine bestimmte Produktkategorie eingebn, auf SUCHEN gehe und die entsprechenden Hersteller angeziegt werden, springt EXCEL immer in die Mitte des Blattes auf Zeile 500 + X und der Benutzer muss immer wieder nervig hochscrollen. Ich habe jetzt schon ewig rumprobiert mit Befehlen, dass z.B. VBA die erste zeile finden soll, die ausgeblndet ist, dann die nachfolgenden Zeilen bis erstwiedereingeblendeten zählt (also der erste Block an Herstellern, der nicht nicht eingeblndet ist) und die diese Anzahl von Zeilen mit der addiert, die es bis zur Kopfzeile sind. Ergo, Excel soll die erste Spalte anzeigen, die nach einer Suche in der Liste zu sehen ist.
Versteht der interessierte leser hier mein Problem, wenn ja, was kann ich zur Problemlösung noch an Infos beisteuern?


beste Grüße und schönes WE
Georg

Hi.

Du solltest versuchen, die Ursache für das Springen in Zeile 500+X zu finden und zu beseitigen. Offenbar steht der Cursor schon an der richtigen Stelle, wird dann aber wieder verschoben. In diesem Fall solltest du die Anfangsposition speichern und ihn dann wieder dorthin zurücksetzen.

Gibt es eine Eigenschaft "IsHidden" oder ähnlich, die angibt, ob eine Zeile ausgeblendet ist oder nicht? Dann könntest du von oben durch die Zeilen wandern und bei der ersten (bzw. letzten) gefundenen anhalten. Wenn du direkt nach der letzten ausgeblendeten Zeile suchst, hast du sogar schon die richtige Anzeigeposition gefunden und musst nicht mehr rechnen.

Alternativ würde ich den Umstieg auf eine richtige Datenbank empfehlen - die Abfrage der Produktkategorie schreit förmlich danach. Wenns nur lokal sein soll, reicht Access völlig aus. Excel kann m.E. auch Daten aus Access per SQL übernehmenund so nur die gewünschten Daten laden / anzeigen.

1) Das Thema wäre in VBA-Programmierung besser aufgehoben gewesen. (Nix für ungut, aber Excel als Datenbank zu bezeichnen, beleidigt die anderen Datenbanken ;)).
2) Kannst du dein "Projekt" mal hochladen, damit man sich etwas darunter vorstellen kann?

Hallo hal2000 und petaod,

besten Dank für eure Antworten! Hier nochmal die Programmierung. Ich muss dazu sagen, dass ist nicht alles von mir, sondern größtenteils von meinem Praktikantenvorgänger. Ich hatte die Ehre die Einträge zu vervollständigen und eben dieses Sprungproblem zu lösen. Das man mir Escel keine Datenbanken erstellen sollte, gab mir der Kollege, der mir ursprünglich die Aufgabe gab, auch mit auf den Weg...


'''''''''''Button. Suche '''''''''''''''''''''''''''''''''

Private Sub CommandButton1_Click()

'''''''''''''' Suchvorgang '''''''''''''''''''''''''''''''

'Worksheets("Tabelle1").Range("A:P").Activate
With Worksheets("Tabelle1").Range("A16:O276")
.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Worksheets("Tabelle1").Range("B9:C11"), _
Unique:=False
End With

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


''''''''''''' Erstellen des Dropdownfeld Produkte ''''''''''''''''

' alte Einträge fürs Dropdown Feld Produktelöschen
Sheets("Tabelle1").Select
Range("S1:AM2000").Select
Selection.ClearContents



' von den gefilterten Daten - nur sichtbare Zellen kopieren und einfügen

Sheets("Tabelle1").Select
Range("B17:B300").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Tabelle1").Select
Range("S1000").Select 'kopieren nach S1000
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False




'Überprüfen ob etwas gefunden wurde

If Application.WorksheetFunction.CountA(Range("S1000")) = 0 Then

Dim strText As String

Range("E12").Select
strText = "!"
MsgBox "Die von Ihnen eingegeben Suchkriterien passen nicht zur Katalogliste." & vbCrLf & " " & vbCrLf & " Bitte setzen Sie gegebenfalls die Suchkriterien leer. " & strText, 16, "Katalogliste - Fehlermeldung"
Exit Sub

End If

'Trennen der gefilterten Liste durch Kommas

Range("S1000:S2000").Select
Application.CutCopyMode = False
Selection.Copy
Range("T1000").Select 'und einfügen hinter T1000
ActiveSheet.Paste
Application.CutCopyMode = False

Application.DisplayAlerts = False ' soll Zielbereich überschrieben werden abschalten

Selection.TextToColumns Destination:=Range("T1000"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

Application.DisplayAlerts = True ' Fehlermeldungen wieder einschalten

' Der nun durch Trennung erstellte bereich muss lückenlos aufgelistet werden


' Dim i As Integer, j As Integer, z As Integer
' Dim StartZeile As Long, StartSpalte As Integer
' Dim EndeZeile As Long, EndeSpalte As Integer

' StartZeile = 1: EndeZeile = 300
' StartSpalte = 20: EndeSpalte = 36
' For i = StartZeile To EndeZeile
' For j = StartSpalte To EndeSpalte
' If Cells(i, j).Value <> "" Then
' If z > 0 Then
' If Not WertInBereich(Range(Cells(1, 37), Cells(z, 37)), Cells(i, j).Value) Then
' z = z + 1
' Cells(z, 37).Value = Cells(i, j).Value
' End If
' Else
' z = 1
' Cells(z, 37).Value = Cells(i, j).Value
' End If
' End If
' Next j
' Next i


' Duplikate werden entfernt

'Dim temp As String
'Dim temp1 As String
'Dim e, t As Long

'Erst sotieren der Liste

' Range("AK1:AK300").Select
' Selection.Sort Key1:=Range("AK1"), Order1:=xlAscending, Header:=xlGuess, _
' OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, DataOption1 _
' :=xlSortNormal

'dann löschen der Duplikate Spalte AK ist Spalte 37

'For t = ActiveSheet.Cells(Rows.Count, 37).End(xlUp).Row To 2 Step -1
' temp = Cells(t, 37)
' temp1 = Cells(t - 1, 37)
'If temp = temp1 Then

'Cells(t, 37).Delete Shift:=xlUp

'End If
'Next

''''''''' kopieren des Bereichs in den Spalten ''''''''''''''''''''''


Dim scrDic
Dim Zelle As Range
Dim bereich As Range
Set scrDic = CreateObject("Scripting.Dictionary")
Set bereich = Sheets("Tabelle1").Range("T1000:AJ2000") 'Ausgewähltenbereich auflisten
On Error Resume Next
For Each Zelle In bereich
scrDic.Add Zelle.Value, 0
Next
On Error GoTo 0
'Ausgeben:
Sheets("Tabelle1").Range("AM1000").Resize(scrDic.Count) = WorksheetFunction.Transpose(scrDic.keys)


' Duplikate werden entfernt

Dim temp As String
Dim temp1 As String
Dim e, t As Long

'Erst sotieren der Liste

Range("Am1000:Am2000").Select
Selection.Sort Key1:=Range("Am1000"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, DataOption1 _
:=xlSortNormal



'dann löschen der Duplikate Spalte AK ist Spalte 37

For t = ActiveSheet.Cells(Rows.Count, 38).End(xlUp).Row To 2 Step -1
temp = Cells(t, 38)
temp1 = Cells(t - 1, 38)
If temp = temp1 Then

Cells(t, 38).Delete Shift:=xlUp

End If
Next


''''''''''''''' Ende der Erstellung des Dropdown Feldes Produkte '''''''''''''

'Function ObereZeile(bereich As Range, suchText As String)
'
'Dim foundCell As Range
'Dim text As String
'Set foundCell = bereich.Find(what:=suchText, LookIn:=xlValues)
'firstAddress = foundCell.Address
'Do
'text = text + foundCell.Address
'Set foundCell = bereich.FindNext(foundCell)
'Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress


If Range("A17").Hidden = True Then



End Sub


'Funktion zur Auflistung belegter Felder wir für das lückenlose auflisten gbraucht

'Function WertInBereich(Bereich As Range, Wert) As Boolean

' Dim i As Long, j As Integer

' WertInBereich = False
' For i = Bereich.Row To Bereich.Row + Bereich.Rows.Count - 1
' For j = Bereich.Column To Bereich.Column + Bereich.Columns.Count - 1
' If Cells(i, j).Value = Wert Then
' WertInBereich = True
' Exit Function
' End If
' Next j
' Next i

'End Function





''''''''''' Button: Zurücksetzten ''''''''''''''''''''''''''''''''''''''''

Private Sub CommandButton2_Click()

On Error Resume Next
ActiveSheet.ShowAllData

' alte Einträge löschen
Sheets("Tabelle1").Select
Range("S1:AM2000").Select
' Selection.ClearContents

' gefilterte Daten - nur sichtbare Zellen kopieren und einfügen

Sheets("Tabelle1").Select
Range("B17:B300").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Tabelle1").Select
Range("S4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

Range("A17").Select

End Sub

Jayromi schrieb:

Das man mir Escel keine Datenbanken erstellen sollte, gab mir der Kollege, der mir ursprünglich die Aufgabe gab, auch mit auf den Weg...

Moment ... "mit Excel keine Datenbank erstellen sollte" ist ja wohl die Untertreibung des Jahrhunderts.

Nur um das klar zu stellen: Excel ist KEINE Datenbank, war auch nie dafür gedacht und kann auch überhaupt nichts was eine Datenbank eigentlich können sollte um den Namen Datenbank zu verdienen. Excel ist eine Tabellenklakulation, nicht mehr und nicht weniger und für Datenhaltung/-verwaltung völlig - aber sowas von völlig - ungeeignet.

Da ihr ja offensichtlich vorhabt das ganze in einer Firma einzusetzen, wäre mein Idee für Dein Problem: Knick it und fang mit einer richtigen Datenbank von vorne an.

Du sparst Dir viel Zeit, Kummer und Nerven und hast am Ende etwas was auch wirklich funktioniert. Nimm halt Access ... da kannste genauso wie in Excel mit VBA arbeiten, es gibt extrem viele Automatismen die den Anfängern helfen eine einfach aber funktionierende Datenbank aufzubauen. Das was Du hier als Aufgabenstellung postest beherrscht Access z.B. von Haus auf per Automatismus (jetzt mal nur durch grob drüberlesen geurteilt), sprich diese simple Funktionalität kannst Du dort nutzen ohne eine einzige Zeile Code zu benötigen.

Also in dem Sinne, sprich mit Deinem Chef erklär ihm das das Vorhaben eine Herstellerdatenbank über Excel zu erstellen völliger Schwachsinn ist und überzeuge ihn davon eine echte DB dafür einzusetzen.

Gruß

Rainer

Eine Selektion über den Excel-Filter zu erstellen ist nicht besonders performant.

Wenn du die erste sichtbare Zelle selektieren willst, kannst du so vorgehen.
Die Methode passt zumindest zu dem Code, der (sorry für die Unterstellung) weitgehend per Makro-Aufzeichnung zusammengeklickt ist.

Wenn es dir nicht ums Selektieren geht, sondern du nur nach oben scrollen willst, geht auch

Uiuiui...ich muss meinen Vorrednern zustimmen: Forget it. Verwende unbedingt eine richtige Datenbank. Das ist um einiges einfacher als den Code des Praktikantenvorgängers zu verstehen und abzuändern. Eventuell kannst du die Daten sogar aus Excel übernehmen - dann bist du recht schnell am Ziel.

Moin raist10, petaod und hal2000,


besten Dank für eure Ratschläge, ich werde das auf jeden Fall weitergeben und für eine stressfreiere "Datenbankszukunft" beherzigen.
@petaod: Vielen Dank für den Tipp mit dem Scrollen Laaaaaaange Vorrede von mir, aber das war der kurze Sinn.


Beste Grüße aus Berlin
Georg