Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Frage an Tino oder Andere | Herbers Excel-Forum


Betrifft: Frage an Tino oder Andere von: Frank H.
Geschrieben am: 15.11.2009 22:17:15

Hallo Tino oder all die Anderen Profis!!!

Tino, dein Code passt. Nun stehe ich aber erneut auf dem Schlauch. In der ListBox werden die Suchergebnisse angezeigt, aber nicht so dargestellt wie in der Tabelle formatiert. Z.B. in der Tabelle steht 06:00 und in der ListBox wird dies als 0,25 angezeigt. Wo ist der Haken???

Besten Dank!!!

Gruß Frank H.

  

Betrifft: AW: Frage an Tino oder Andere von: OttoH
Geschrieben am: 15.11.2009 22:27:18

Hallo Frank,

formatiere die Zellen mal als Uhrzeit: hh:mm

Gruß OttoH


  

Betrifft: AW: Frage an Tino oder Andere von: Gerd L
Geschrieben am: 15.11.2009 22:28:59

Hallo Frank,

"der Haken" ist, dass in den Datenfeldern die Value-Eigenschaft der Werte/Zelleneinträge verarbeitet wird.

Hast Du den Code u. Userform von Tino unverändert übernommen?

Gruß Gerd


  

Betrifft: AW: Frage an Tino oder Andere von: Frank H.
Geschrieben am: 15.11.2009 22:41:23

Hallo Gerd!!!

Nach vielen Probierereien war Tino ausnahmsweise bereit direkt in meiner Datei den Code einzubauen:

Sub LadeDatenListBox(ByRef ArData, Datum As Date)
Dim Ar2, Ar3(), TempAR()
Dim A&, AA&, AAA&
Dim LRowMax As Long

With Tabelle1
LRowMax = .Cells(.Rows.Count, 53).End(xlUp).Row
If LRowMax < 3 Then Exit Sub 'keine Daten
Ar2 = .Range(.Cells(3, 53), .Cells(LRowMax, 68))
ReDim Preserve Ar3(1 To UBound(Ar2, 2), 1 To UBound(Ar2))
End With



For A = 1 To UBound(Ar2)
If Ar2(A, 1) = Datum Then
AAA = AAA + 1
For AA = 1 To UBound(Ar2, 2)
Ar3(AA, AAA) = Ar2(A, AA) 'Daten aus Spalte 53 bis 69
Next AA
End If
Next A

If AAA > 0 Then
ReDim Preserve Ar3(1 To UBound(Ar3), 1 To AAA)
If AAA = 1 Then
ReDim Preserve TempAR(1 To 1, 1 To UBound(Ar3))
For A = 1 To UBound(Ar3)
TempAR(1, A) = Ar3(A, 1)
Next A
ArData = TempAR
Else
ArData = Application.Transpose(Ar3)
End If

End If

End Sub

Private Sub cmdSuchen_Click()
Dim ArData
ListBox1.Clear
If TextBox1 <> "" And IsDate(TextBox1) Then
 
 LadeDatenListBox ArData, CDate(TextBox1)
 
 If IsArray(ArData) Then
  ListBox1.ColumnCount = UBound(ArData, 2)
  ListBox1.List = ArData
 End If

End If

End Sub
Der erste Teil steht in einem Modul!

Könnt ihr damit etwas anfangen???

Gruß Frank H.


  

Betrifft: AW: Frage an Tino oder Andere von: Nepumuk
Geschrieben am: 15.11.2009 23:13:34

Hallo Frank,



wie viele Datensätzewerden denn durchschnittlich in der Listbox angezeigt?



Wenn es sich nur um 20-50 Zeilen handelt, ist die Einsparung durch die Verarbeitung über ein Array irgendwo im Millisekundenbereich und der Aufwand, die Arrayeinträge nachträglich zu formatieren würde sich dann nicht lohnen. Du könntest also die Text-Eigenschaft der Zelle in das Array schreiben.



Sind es es mehrere hundert, würde ich beim Array bleiben und die Spalten darin mit der Format-Funktion in Form bringen.



Gruß

Nepumuk


  

Betrifft: AW: Frage an Tino oder Andere von: Gerd L
Geschrieben am: 15.11.2009 23:16:57

Hallo Frank,

ich habe in der Lade-Prozedur etwas rumgeprimelt. Teste mal.

Sub LadeDatenListBox(ByRef ArData, Datum As Date)
Dim Ar2, Ar3(), TempAR()
Dim A&, AA&, AAA&
Dim LRowMax As Long


Dim i As Long
Dim j As Long

With Tabelle1
LRowMax = .Cells(.Rows.Count, 53).End(xlUp).Row
If LRowMax < 3 Then Exit 
Sub 'keine Daten
Ar2 = .Range(.Cells(3, 53), .Cells(LRowMax, 68))




For i = 3 To LRowMax
For j = 53 To 68
Ar2(i - 2, j - 52) = CStr(.Cells(i, j).Text)
Next
Next





ReDim Preserve Ar3(1 To UBound(Ar2, 2), 1 To UBound(Ar2))
End With


For A = 1 To UBound(Ar2)
If Ar2(A, 1) = Datum Then
AAA = AAA + 1
For AA = 1 To UBound(Ar2, 2)
Ar3(AA, AAA) = Ar2(A, AA) 'Daten aus Spalte 53 bis 69
Next AA
End If
Next A

If AAA > 0 Then
ReDim Preserve Ar3(1 To UBound(Ar3), 1 To AAA)
If AAA = 1 Then
ReDim Preserve TempAR(1 To 1, 1 To UBound(Ar3))
For A = 1 To UBound(Ar3)
TempAR(1, A) = Ar3(A, 1)
Next A
ArData = TempAR
Else
ArData = Application.Transpose(Ar3)
End If

End If

End Sub


Gruß Gerd


  

Betrifft: Datum kommt nur einmal in Liste vor von: Tino
Geschrieben am: 15.11.2009 22:59:54

Hallo,
ich habe Dir noch eine Version geschickt
weil in Deiner Liste jedes Datum nur einmal vorkommt(habe ich zu spät gesehen),
dies ist dann viel einfacher.

Hier der Code übernimmt das Format der Zelle.

kommt als Code in ModulListBoxFuellen

Option Explicit 
 
Sub LadeDatenListBox(ByRef ArData, Datum As Date) 
Dim Ar3() 
Dim AA&, LRowMax& 
 
With Tabelle1 
    LRowMax = Application.Match(CLng(Datum), .Columns(53), 0) 
    If Not IsNumeric(LRowMax) Then Exit Sub  'keine Daten 
    Redim Preserve Ar3(1 To 1, 1 To 16) 
    For AA = 1 To Ubound(Ar3, 2) 
         Ar3(1, AA) = Format(.Cells(LRowMax, 52 + AA), .Cells(LRowMax, 52 + AA).NumberFormat) 'Daten aus Spalte 53 bis 69 
    Next AA 
End With 
 
ArData = Ar3 
 
 
End Sub 



Man könnte auch direkt auf den Zellbereich mit RowSource Verweisen müsste auch gehen.

Kannst auch mal testen.

Direkt in der Userform

Dim vRowMax
With Tabelle1
    vRowMax = Application.Match(CLng(Datum), .Columns(53), 0)
    If Not IsNumeric(vRowMax) Then
         frmEingabe.ListBox1.RowSource = _
         Range(.Cells(vRowMax, 53), .Cells(vRowMax, 69)).Address(external:=True)
    End If
End With
In der ListBox ColumnCount auf 16 einstellen.


Gruß Tino


  

Betrifft: AW: Datum kommt nur einmal in Liste vor von: Frank H.
Geschrieben am: 16.11.2009 09:51:03

Hallo Alle Zusammen!!!

Euch allen herzlichst Danke, Danke und nochmals Danke!!! In besonderer Weise gilt mein Dank Tino!!!

Tino, deinen Code - Teil 1 - habe ich übernommen, Teil 2 werde ich noch testen, muss jetzt aber weg!!!

Ihr seid alle Funzkerle und Spitze - geiles Forum!!!

Gruß Frank H.


Beiträge aus den Excel-Beispielen zum Thema "Frage an Tino oder Andere"