Josef Ehrensberger - Userform noch ein "Problem"

Forumthread: Josef Ehrensberger - Userform noch ein "Problem"

09.05.2006 00:44:39

Franc

Jetzt wo ich es getestet habe, habe ich festgestellt das der Scrollbalken in der Listbox weit über das Ziel hinausschießt.
Das macht sich besonders in der Originalliste negativ bemerkbar.
Sie beinhaltet mehrere tausend einträge.
wenn ich bis zum letzten angezeigten Eintrag scrolle, kommt ein fast endloses weißes Feld. Kann man den Scrollbalken an die länge der gefundenen Einträge anpassen?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Excel zählt ausgefilterte Zellen mit :-(

09.05.2006 03:57:34

Franc

Das Problem liegt darin, das er die versteckten Zeilen NICHT ignoriert.
Die Anweisung das er die letzte Zelle als Ende nehmen soll führt teilweise dazu, das dieser Wert bei 5.000 oder höher liegt. (obwohl es nur 10 gefundene Objekte sind aber der 10. halt in Zeile 5.000 steht) Demnach hat dann auch die Listbox in der Userform 5.000 Zeilen.
Kann man das Makro insoweit ergänzen das es automatisch leere Zeilen in der Listbox löscht?

AW: Excel zählt ausgefilterte Zellen mit :-(

09.05.2006 14:22:31

Sebastian

Ich habe ein ähnliches Problem gehabt und habe es so gelöst:
NextZeile:
If Worksheets(Quelle).Cells(zeilennummer, 1).EntireRow.Hidden = True Then
'Hier kannst du deinen Code einfügen
GoTo NextZeile 'Rücksprung zum Beginn der Sub
End If

AW: Excel zählt ausgefilterte Zellen mit :-(

09.05.2006 23:36:17

Josef

Hallo Franc!
Ersetze diese zwei Prozeduren!

Private Sub setList()
Dim lngRow As Long, lngLast As Long, lngIndex As Long

lngLast = Cells(Rows.Count, 1).End(xlUp).Row

ListBox1.Clear

For lngRow = 2 To lngLast
  If Rows(lngRow).Hidden = False Then

    With ListBox1
      .AddItem Cells(lngRow, 1)
      .List(.ListCount - 1, 1) = Cells(lngRow, 3)
      .List(.ListCount - 1, 2) = Cells(lngRow, 7)
      .List(.ListCount - 1, 3) = Cells(lngRow, 9)
      .List(.ListCount - 1, 4) = Cells(lngRow, 10)
      .List(.ListCount - 1, 5) = Cells(lngRow, 14)
      .List(.ListCount - 1, 6) = Cells(lngRow, 15)
    End With

  End If
Next
If ListBox1.ListCount > 0 Then
  setColCountAndWidth ListBox1, ListBox1.List
End If
End Sub

Private Function setColCountAndWidth(ByRef theBox As Object, ByVal theList As Variant, _
  Optional setBoxWidth As Boolean = False)
'by Josef Ehrensberger (11/2005)
'######## PARAMETER ###########################################################
'~~~~~~~~~~~~~~~~~~~ theBox = List- oder Combo- Box in UF oder Tabelle
'~~~~~~~~~~~~~~~~~~~ theList = Die Liste als Array
'~~~~~~~~~~~~~~~~~~~ setBoxWidth = Breite der Box anpassen
'######## BEISPIEL ############################################################
'
' setColCountAndWidth Listbox1, myArray, True
'
' setColCountAndWidth ComboBox1, ComboBox1.List
'
' setColCountAndWidth Sheets(1).ComboBox1, Sheets(1).ComboBox1.List
'
'##############################################################################

Dim iCol As Integer, lRow As Long, dblMax As Double, dblWidth As Double
Dim objDummy As Object
Dim strColWidth As String

If TypeOf theBox.Parent Is MSForms.UserForm Then
  Set objDummy = theBox.Parent.Controls.Add("Forms.TextBox.1", "txtDummy", False)
ElseIf TypeOf theBox.Parent Is Worksheet Then
  Set objDummy = theBox.Parent.OLEObjects.Add(ClassType:="Forms.TextBox.1", Top:=0, _
    Left:=0, Width:=0, Height:=0)
Else
  Exit Function
End If

With objDummy
  .Visible = False
  .Object.Font.Name = theBox.Font.Name
  .Object.Font.Size = theBox.Font.Size
  .Object.AutoSize = True
  .Object.IntegralHeight = False
End With

For iCol = LBound(theList, 2) To UBound(theList, 2)
  For lRow = LBound(theList, 1) To UBound(theList, 1)
    objDummy.Object.Text = vbNullString
    On Error Resume Next
    objDummy.Object.Text = CStr(theList(lRow, iCol))
    On Error GoTo 0
    If objDummy.Width > dblMax Then dblMax = objDummy.Width
  Next
  dblWidth = dblWidth + dblMax
  strColWidth = strColWidth & CStr(dblMax) & ";"
  dblMax = 0
Next

With theBox
  .ColumnCount = UBound(theList, 2) + IIf(LBound(theList, 2) = 0, 1, 0)
  .ColumnWidths = Left(strColWidth, Len(strColWidth) - 1)
  .List = theList
  If setBoxWidth Then .Width = dblWidth + 5
End With

On Error Resume Next
objDummy.Delete
Set objDummy = Nothing
End Function

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Beliebteste Forumthreads (12 Monate)

Josef Ehrensberger - Userform noch ein "Problem"

Forumthread: Josef Ehrensberger - Userform noch ein "Problem"

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Josef Ehrensberger - Userform noch ein "Problem"

Forumthread: Josef Ehrensberger - Userform noch ein "Problem"

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread