2016-06-26 9 views
0

Ich habe einen Code, der nach "! UKINADMISSIBLE" in Spalte "M" des Blattes sucht. dann zeigt es alle ausgewählten Zeilen mit "! UKINADMISSIBLE" in einem Listenfeld (listbox1) an. es funktioniert gut, aber wenn ich alle "! UKINADMISSIBLE" aus dem Blatt lösche, gibt es mir diesen Fehler (konnte die Listeneigenschaft, Ungültiger Eigenschaftswert) nicht auf diese Codezeile setzen --->Me.ListBox1.List = arrLstBox () ---> Fehler Kann mir bitte jemand helfen, es zu reparieren.konnte die Listeneigenschaft nicht festlegen. Ungültiger Eigenschaftswertfehler

Private Sub btnIUK_Click() 

Dim arrLstBox() 
Dim rng, FoundCell, tmpCell As Range 
Dim i, j, numRows, lastColumn, lastRow As Long 
Dim FirstAddress, searchFor, colWidth As String 

Set rng = ActiveSheet.UsedRange 
numRow = 0 

With rng 

    lastRow = .Rows.Count 
    lastColumn = .Columns.Count 

End With 

Me.ListBox1.ColumnCount = lastColumn 
Me.ListBox1.ColumnWidths = "60;70;190;40;90;90;70;80;50;60;90;120;5" 


    Set FoundCell = rng.Find(what:="!UKINADMISSIBLE", LookIn:=xlValues, lookat:=xlWhole) 

    If Not FoundCell Is Nothing Then _ 
    FirstAddress = FoundCell.Address 

    Do Until FoundCell Is Nothing 

     Set FoundCell = rng.FindNext(after:=FoundCell) 

     If FoundCell.Address = FirstAddress Then 
      numRow = numRow + 1 
      Exit Do 
     ElseIf FoundCell.Row <> rng.FindNext(after:=FoundCell).Row Then 
      numRow = numRow + 1 
     End If 

ReDim arrLstBox(1 To numRow + 1, 1 To lastColumn + 1) 

Loop 

Do Until FoundCell Is Nothing 

    For i = 1 To numRow 
     For j = 1 To lastColumn 

      If Not IsEmpty(Cells(FoundCell.Row, j).Value) Then 

       arrLstBox(i, j) = Cells(FoundCell.Row, j).Value 

      End If 


     Next j 

     Set FoundCell = rng.FindNext(after:=FoundCell) 

     If FoundCell.Address = FirstAddress Then _ 
      Exit For 

    Next i 

    If FoundCell.Address = FirstAddress Then _ 
      Exit Do 

Loop 

Me.ListBox1.List = arrLstBox()----->ERROR 

lastRow = ListBox1.ListCount 
MsgBox "Records Found = " & lastRow, vb, "Inadmissibles On UK Sectors" 

End Subode here 

Antwort

0

Das Problem ist, dass Ihr Array leer ist. In Ihrem Code sollten Sie dafür testen und einfach Clear die ListBox wenn es der Fall ist.

Ihr Code scheint ein wenig ineffizient. Sie suchen beispielsweise das gesamte Dokument nach einem Artikel, den Sie nur in Spalte M finden möchten, und führen die Suche zweimal aus. Warum nicht einmal in Spalte M suchen und die Trefferzeilen in einer Variablen speichern? Sie könnten dann einfach das Array ListBox mit diesen Zeilen füllen. Sie können auch erwägen, die ListBox Spalten nur einmal in Ihrem Userform_Initialize Event zu skalieren.

Sie sollten auch wissen, dass die meisten Ihrer Deklarationen Variants sind. Sie müssen jede Variable explizit wie diese Dim a As Integer, b As Integer deklarieren.

Ein Skelett-Code für diese könnte wie unten etwas aussehen:

Option Explicit 

Private Sub btnIUK_Click() 
    Dim v As Variant 
    Dim i As Long 
    Dim j As Long 
    Dim hits As Collection 
    Dim hit As Variant 
    Dim arrItems() As Variant 

    'Read values into an array 
    v = ThisWorkbook.Worksheets("Sheet1").UsedRange.Value2 

    'Find the target values 
    Set hits = New Collection 
    For i = 1 To UBound(v, 1) 
     If v(i, 13) = "!UKINADMISSIBLE" Then hits.Add i 
    Next 

    'Populate the listbox array with the hit items 
    If hits.Count > 0 Then 
     ReDim arrItems(1 To hits.Count, 1 To UBound(v, 2)) 
     i = 1 
     For Each hit In hits 
      For j = 1 To 13 
       arrItems(i, j) = v(hit, j) 
      Next 
      i = i + 1 
     Next 
     Me.ListBox1.List = arrItems 
    Else 
     'There are not hits so clear the listbox 
     Me.ListBox1.Clear 
    End If 

End Sub 

Private Sub UserForm_Initialize() 
    With Me.ListBox1 
     .ColumnCount = 13 
     .ColumnWidths = "60;70;190;40;90;90;70;80;50;60;90;120;5" 
    End With 

End Sub 
+0

danken Lasten, es wirklich zu schätzen. Danke nochmal :) –

+0

danke dir Ambie, wirklich cool –

0

Sie fast da waren. Nur Elemente listbox hinzufügen, wenn es mindestens eine Zelle in der Spalte M mit gesuchtem Wert ist

Außerdem, wenn Daten hinzugefügt immer werden Sie von A bis M dann in Spalten könnten beide vermeiden Spalten und verschieben listbox Einstellungen auf einen UserForm_Initialize Sub Zählen .

So:

Private Sub btnIUK_Click() 

Dim arrLstBox() As Variant 
Dim foundCell As Range 
Dim i As Long, j As Long, nCells As Long 
Dim firstAddress As String 

With ThisWorkbook.Worksheets("MySheet") '<--| always specify the worksheet name 
    With .Range("M", .Cells(.Rows.Count, 13).End(xlUp)) '<--| consider column M cells down to its last non empty one 
     nCells = WorksheetFunction.CountIf(.Cells, "!UKINADMISSIBLE") '<--| count searched value occurrences in column M 
     If nCells > 0 then '<--| If there's at least one occurrence ... 
      ReDim arrLstBox(1 To nCells, 1 To 13) '<--| ... ReDim your array... 
      Set foundCell = .Find(what:="!UKINADMISSIBLE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) '<--| ...find first occurrence (it's there for sure!) 
      firstAddress = foundCell.Address '<--| ...and store first occurrence address 
      Do '<--| first loop is granted! 
       i = i + 1 '<--| update array row index 
       For j = 1 To 13 '<--| fill array row 
        arrLstBox(i, j) = foundCell.Offset(,-13 + j) '<--| use Offset from found cell to sta in its row and loop through columns 1 To 13 
       Next 
       Set foundCell = .FindNext (foundCell) '<--| look for subsequent occurrence 
      Loop While firstAddress <> foundCell.Address '<--| subsequent loops are made till Find() wraps back to the first one 
      Me.ListBox1.List = arrLstBox 
     End If '<--| fill listbox 
    End With 
End With 
MsgBox "Records Found = " & nCells, vb, "Inadmissibles On UK Sectors" 

End Sub 


Private Sub UserForm_Initialize() 
    With Me.ListBox1 
     .ColumnCount = 13 
     .ColumnWidths = "60;70;190;40;90;90;70;80;50;60;90;120;5" 
    End With 
End Sub 
+0

Oh yeah Ich habe ein paar Code Zeilen vermasselt. danke user3598756 für Ihre Zeit. gut geschätzt. –

Verwandte Themen