返回列表 上一主題 發帖

[發問] 執行階段錯誤'380'

本帖最後由 samwang 於 2021-7-29 15:12 編輯

回復 8# wang077

請測試看看,謝謝

Private Sub CommandButton3_Click()
Dim Arr, Ar(), xD, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
b = ComboBox1.Text
Sheets(b).Select
If Me.ComboBox2.Text <> "" And Me.ComboBox3.Text = "" Then
    Arr = Sheets(b).AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
    ReDim Ar(1 To UBound(Arr) + 1, 1 To UBound(Arr, 2))
    For j = 1 To UBound(Arr, 2)
        If j > 4 And j < 36 Then GoTo 99
        For i = 1 To UBound(Arr)
            If Arr(i, j) <> "" Then
                If xD(Arr(i, j)) <> 1 Then
                    xD(Arr(i, j)) = 1
                    If j <> j1 Then j1 = j: n = n + 1
                    If Ar(1, n) = "" Then Ar(1, n) = Cells(2, j)
                    If j = 36 And i = UBound(Arr) Then
                        Ar(i + 1, n) = Format(Arr(i, j), "0%")
                    Else
                        Ar(i + 1, n) = Arr(i, j)
                    End If
                End If
            End If
        Next
99: Next
    With Me.ListBox1
      .List = Ar
      .ColumnCount = n
    End With
End If
Sheets(b).Select
End Sub
1.PNG

TOP

本帖最後由 singo1232001 於 2021-7-29 15:34 編輯

回復 7# wang077


若想找資料架構的學習教材相關
請上網查詢 "資料庫正規化" "資料庫范式" 或者"資料庫架構" 與 "關聯式資料庫"

test (4).zip (60.28 KB)

TOP

回復 12# singo1232001
非常感謝大大
我會去研究看看的!

TOP

本帖最後由 wang077 於 2021-7-29 16:35 編輯

回復 11# samwang
大大,如果我D欄只要入庫、良品、良率呢,且D欄可重複顯示

TOP

回復 14# wang077

請測試看看,謝謝

Private Sub CommandButton3_Click()
Dim Arr, Ar(), xD, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
b = ComboBox1.Text
Sheets(b).Select
If Me.ComboBox2.Text <> "" And Me.ComboBox3.Text = "" Then
    Arr = Sheets(b).AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
    ReDim Ar(1 To UBound(Arr) + 1, 1 To UBound(Arr, 2))
    For j = 1 To UBound(Arr, 2)
        If j > 4 And j < 36 Then GoTo 99
        For i = 1 To UBound(Arr)
            If j > 3 Then
                If Arr(i, j) = "不良" Then i1 = i: GoTo 98
                If Arr(i, j) = "報廢" Then i2 = i: GoTo 98
                If i1 = i Or i2 = i Then GoTo 98
            End If
            If Arr(i, j) <> "" Then
                If xD(Arr(i, j)) <> 1 Then
                   If j < 35 Then xD(Arr(i, j)) = 1
                    If j <> j1 Then j1 = j: n = n + 1: m = 2
                    Ar(1, n) = Cells(2, j)
                    If j = 36 And i = UBound(Arr) Then
                        Ar(m, n) = Format(Arr(i, j), "0%")
                    Else
                        Ar(m, n) = Arr(i, j): m = m + 1
                    End If
                End If
            End If
98:   Next
99: Next
    With Me.ListBox1
       .ColumnWidths = "30,30,30,40,40"
      .List = Ar
      .ColumnCount = n
    End With
End If
Sheets(b).Select
End Sub
2.PNG

TOP

回復 15# samwang
大大,我有寄檔案到你的gmail
可以麻煩你看一下嗎,謝謝

TOP

回復 16# wang077

請測試看看,謝謝

Private Sub CommandButton3_Click()
Dim Arr, Ar(), xD, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
b = ComboBox1.Text
Sheets(b).Select
If Me.ComboBox2.Text <> "" And Me.ComboBox3.Text = "" Then
    Arr = Sheets(b).AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
    ReDim Ar(1 To UBound(Arr), 1 To 4): m = 1
    For i = 1 To UBound(Arr)
        T = Arr(i, 1) & Arr(i, 2) & Arr(i, 4)
        If InStr(T, "提檢數") Or InStr(T, "良品數") Or InStr(T, "良率") Then
            If xD(T & "/3") <> 1 Then
                xD(T & "/3") = 1: m = m + 1
                If Ar(1, 1) = "" Then '第1列
                    Ar(1, 1) = Cells(2, 1): Ar(1, 2) = Cells(2, 2)
                    Ar(1, 3) = Cells(2, 4): Ar(1, 4) = Cells(2, 36)
                End If
                If xD(Arr(i, 1) & "/1") <> 1 Then xD(Arr(i, 1) & "/1") = 1: Ar(m, 1) = Arr(i, 1)
                If xD(Arr(i, 2) & "/2") <> 1 Then xD(Arr(i, 2) & "/2") = 1: Ar(m, 2) = Arr(i, 2)
                Ar(m, 3) = Arr(i, 4)
                If InStr(T, "良率") Then Ar(m, 4) = Format(Arr(i, 36), "0%") Else Ar(m, 4) = Arr(i, 36)
            End If
        End If
    Next
   
    With Me.ListBox1
      .ColumnWidths = "40,50,70,40"
      .List = Ar
      .ColumnCount = m
    End With
End If
Sheets(b).Select
End Sub

TOP

回復 16# wang077


不好意思,更新17樓程式,將第1列移到迴圈外,謝謝
   
Private Sub CommandButton3_Click()
Dim Arr, Ar(), xD, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
b = ComboBox1.Text
Sheets(b).Select
If Me.ComboBox2.Text <> "" And Me.ComboBox3.Text = "" Then
    Arr = Sheets(b).AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
    ReDim Ar(1 To UBound(Arr), 1 To 4): m = 1
    Ar(1, 1) = Cells(2, 1): Ar(1, 2) = Cells(2, 2)  '第一列
    Ar(1, 3) = Cells(2, 4): Ar(1, 4) = Cells(2, 36)

   
    For i = 1 To UBound(Arr)
        T = Arr(i, 1) & Arr(i, 2) & Arr(i, 4)
        If InStr(T, "提檢數") Or InStr(T, "良品數") Or InStr(T, "良率") Then
            If xD(T & "/3") <> 1 Then
                xD(T & "/3") = 1: m = m + 1
                If xD(Arr(i, 1) & "/1") <> 1 Then xD(Arr(i, 1) & "/1") = 1: Ar(m, 1) = Arr(i, 1)
                If xD(Arr(i, 2) & "/2") <> 1 Then xD(Arr(i, 2) & "/2") = 1: Ar(m, 2) = Arr(i, 2)
                Ar(m, 3) = Arr(i, 4)
                If InStr(T, "良率") Then Ar(m, 4) = Format(Arr(i, 36), "0%") Else Ar(m, 4) = Arr(i, 36)
            End If
        End If
    Next
   
    With Me.ListBox1
      .ColumnWidths = "40,50,70,40"
      .List = Ar
      .ColumnCount = m
    End With
End If
Sheets(b).Select
End Sub

TOP

回復 18# samwang
感謝大大幫忙,我有回信到你的mail喔!

TOP

話說這種表單查詢有何做用???
若是因為表格橫寬及縱長太大, 想調出指定資料做修改,
那還是在原表操作較實在~~

TOP

        靜思自在 : 世上有兩件事不能等:一、孝順 二、行善。
返回列表 上一主題