Autor
|
Thema: Suchen mit VB (2016 mal gelesen)
|
Prinzcan Mitglied
Beiträge: 81 Registriert: 30.08.2010
|
erstellt am: 26. Sep. 2011 12:03 <-- editieren / zitieren --> Unities abgeben:
Hallo Zusammen, da ich noch ziemlich unerfahren mit VB bin würde ich gerne wissen wie ich das folgende Problem lösen kann: und zwar möchte ich ein bestehendes VB Program den ich erhalten habe erweitern. Auf dem beigefügten Bild kann man erkennen das die Ausgabemaske mir nur 7 werte ausgibt also von "Blatt" bis "Hersteller" Doch wie kann ich das erweitern ich möchte das ich mehr als 7 werte ausgeben kann. Zudem habe ich das Problem das zu lange texte nicht vollständig angezeigt werden wie kann ich dies korrigieren ? Das Programm dazu sieht wie folgt aus : Private Sub CommandButton1_Click() Dim xSuche, xAdresse, xErste As String Dim y As Boolean Dim arr() As Variant Dim rng As Range Dim iCounter, iRowU As Integer ListBox1.Clear xSuche = TextBox1.Value If xSuche = "" Then MsgBox "Bitte erst einen Suchbegriff eingeben!", vbExclamation, "Achtung!" Exit Sub End If If ComboBox1.Value = "" And CheckBox2.Value = False Then MsgBox "Bitte geben Sie ein, wo der Begriff gesucht werden soll!", vbExclamation, "Achtung!" Exit Sub End If For iCounter = 1 To ThisWorkbook.Sheets.Count If CheckBox2.Value = True Or Worksheets(iCounter).Name = ComboBox1.Value Then Set rng = Worksheets(iCounter).Cells.Find _ (xSuche, lookat:=Suchart, LookIn:=xlValues) If Not rng Is Nothing Then With Worksheets(iCounter) xErste = rng.Address(False, False) y = True Do Until xAdresse = xErste ReDim Preserve arr(0 To 6, 0 To iRowU) arr(0, iRowU) = .Name arr(1, iRowU) = rng.Address(False, False) arr(2, iRowU) = .Cells(rng.Row, 1) arr(3, iRowU) = .Cells(rng.Row, 2) arr(4, iRowU) = .Cells(rng.Row, 3) arr(5, iRowU) = .Cells(rng.Row, 4) arr(6, iRowU) = .Cells(rng.Row, 5) iRowU = iRowU + 1 Set rng = .Cells.FindNext(after:=rng) xAdresse = rng.Address(False, False) Loop xAdresse = "" xErste = "" End With End If End If Next iCounter If y = False Then MsgBox "Der Suchbegriff wurde nicht gefunden!" Else ListBox1.Column = arr End If End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Ehrenmitglied V.I.P. h.c. Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007 @Work Lenovo P510 Xeon E5-1630v4 64GB DDR4 Quadro P2000 256GB PCIe SSD 512GB SSD SmarTeam V5-6 R2016 Sp04 CATIA V5-6 R2016 Sp05 E3.Series V2019 Altium Designer/Concord 19 Win 10 Pro x64
|
erstellt am: 26. Sep. 2011 12:49 <-- editieren / zitieren --> Unities abgeben: Nur für Prinzcan
Hallo, es fehlt einiges an Code! Die Erweiterung der Oberfläche, muss auch im Editor passieren. Demnach muss der Listbox eine weitere Spalte hinzugefügt werden. Das könnte auch im Programm passieren, aber das sehe ich eben nicht, da du nur den Code vom Objekt "CommandButton1" für das Ereigniss "Click" gepostet hast. Um die Liste dann zu befüllen, musst du das Array "arr()" um 1 in der ersten Dimension erweitern. Demnach muss dass "ReDim Preserve arr(0 To 6, 0 To iRowU)" > "ReDim Preserve arr(0 To 7, 0 To iRowU)" so aussehen. Dann kannst du den achten Parameter mit "arr(7, iRowU) = .Cells(rng.Row, 6)" dem Array hinzufügen. Wie nun allerdings die Daten in das Listelement geschrieben werden, geht ebenfalls nicht aus dem Code hervor! Code: Private Sub CommandButton1_Click() Dim xSuche, xAdresse, xErste As String Dim y As Boolean Dim arr() As Variant Dim rng As Range Dim iCounter, iRowU As IntegerListBox1.Clear xSuche = TextBox1.Value If xSuche = "" Then MsgBox "Bitte erst einen Suchbegriff eingeben!", vbExclamation, "Achtung!" Exit Sub End If If ComboBox1.Value = "" And CheckBox2.Value = False Then MsgBox "Bitte geben Sie ein, wo der Begriff gesucht werden soll!", vbExclamation, "Achtung!" Exit Sub End If For iCounter = 1 To ThisWorkbook.Sheets.Count If CheckBox2.Value = True Or Worksheets(iCounter).Name = ComboBox1.Value Then Set rng = Worksheets(iCounter).Cells.Find _ (xSuche, lookat:=Suchart, LookIn:=xlValues) If Not rng Is Nothing Then With Worksheets(iCounter) xErste = rng.Address(False, False) y = True Do Until xAdresse = xErste ReDim Preserve arr(0 To 7, 0 To iRowU) arr(0, iRowU) = .Name arr(1, iRowU) = rng.Address(False, False) arr(2, iRowU) = .Cells(rng.Row, 1) arr(3, iRowU) = .Cells(rng.Row, 2) arr(4, iRowU) = .Cells(rng.Row, 3) arr(5, iRowU) = .Cells(rng.Row, 4) arr(6, iRowU) = .Cells(rng.Row, 5) arr(7, iRowU) = .Cells(rng.Row, 6) iRowU = iRowU + 1 Set rng = .Cells.FindNext(after:=rng) xAdresse = rng.Address(False, False) Loop xAdresse = "" xErste = "" End With End If End If Next iCounter If y = False Then MsgBox "Der Suchbegriff wurde nicht gefunden!" Else ListBox1.Column = arr End If End Sub
------------------ MFG Rick Schulz Nettiquette (CAD.de) - Was ist die Systeminfo? - Wie man Fragen richtig stellt. - Unities Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 26. Sep. 2011 12:50 <-- editieren / zitieren --> Unities abgeben: Nur für Prinzcan
Hi Prinzcan, copy+paste ohne Quellenangabe ? Zu Deinen Fragen... 1. "Doch wie kann ich das erweitern ich möchte das ich mehr als 7 werte ausgeben kann." - Habe den Code nicht laufen lassen, vermute aber hier: Code: ...Do Until xAdresse = xErste ReDim Preserve arr(0 To 6, 0 To iRowU)...
Beginnt bei Null, läuft bis 6, also 7 Werte. Ergänze eine Zeile mit einer 7 (arr(7, iRowU) = .Cells(rng.Row, 6)) und schau, was passiert.2. "...das zu lange texte nicht vollständig angezeigt werden " Ich tippe auf die Eigenschaften der Box. Schau mal, ob Du dort den (Zeilen)Umbruch einstellen kannst oder was bei Wordwrap so geht. ------------------ DIN1055.de | Lastannahmen für Anwender Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Ehrenmitglied V.I.P. h.c. Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007
|
erstellt am: 26. Sep. 2011 12:56 <-- editieren / zitieren --> Unities abgeben: Nur für Prinzcan
|
Prinzcan Mitglied
Beiträge: 81 Registriert: 30.08.2010
|
erstellt am: 26. Sep. 2011 13:25 <-- editieren / zitieren --> Unities abgeben:
|
Prinzcan Mitglied
Beiträge: 81 Registriert: 30.08.2010
|
erstellt am: 26. Sep. 2011 14:06 <-- editieren / zitieren --> Unities abgeben:
also die idee mit einer Zeile dazu ergänzen hatte ich auch ich meine also : (arr(7, iRowU) = .Cells(rng.Row, 6)) aber trotzdem wird in der ausgabemaske kein weiterer wert angezeigt ich kann aber zum bsp sagen (arr(6, iRowU) = .Cells(rng.Row, 13)) dann würde er den Inhalt von spalte 13 feld 6 einfügen aber so wie ich es will, macht er es nicht. Habe auch mir Wordwap angeschaut auch dieses Problem kann ich damit nicht lösen :-( Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 26. Sep. 2011 15:33 <-- editieren / zitieren --> Unities abgeben: Nur für Prinzcan
|
Prinzcan Mitglied
Beiträge: 81 Registriert: 30.08.2010
|
erstellt am: 26. Sep. 2011 15:54 <-- editieren / zitieren --> Unities abgeben:
|
runkelruebe Moderator Straßen- / Tiefbau
Beiträge: 8075 Registriert: 09.03.2006 MS-Office 365 ProPlus x86 WIN7(x64)
|
erstellt am: 26. Sep. 2011 16:07 <-- editieren / zitieren --> Unities abgeben: Nur für Prinzcan
|
| Planungsexperte (m/w/d) für die Instandsetzung von Parkimmobilien | GOLDBECK?realisiert zukunftsweisende Immobilien in Europa. Wir verstehen Gebäude als Produkte und bieten alle Leistungen aus einer Hand: vom Design über den Bau bis zu Services im Betrieb. Aktuell beschäftigt unser Familienunternehmen mehr als 12.000 Mitarbeitende an über 100 Standorten bei einer?Gesamtleistung von über 6 Mrd. Euro. Unser Anspruch ?building?excellence? steht dabei für Spitzenleistungen ... | Anzeige ansehen | Architektur |
|
Prinzcan Mitglied
Beiträge: 81 Registriert: 30.08.2010
|
erstellt am: 26. Sep. 2011 16:09 <-- editieren / zitieren --> Unities abgeben:
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|