123
返回列表 上一主題 發帖

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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
11# 跳轉到 »
發表於 2021-7-29 15:08 | 只看該作者
本帖最後由 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 (64.46 KB)

1.PNG

TOP

singo1232001
　暱稱: 熱狗慶

中學生Rank: 2

帖子
354 
主題
5 
精華
0 
積分
387 
點名
0  
作業系統
windows7 
軟體版本
vba,vb,excel2007 
閱讀權限
20 
性別
男 
註冊時間
2017-1-8 
最後登錄
2024-8-2 

論壇榮譽勳章論壇贊助勳章
12#
發表於 2021-7-29 15:32 | 只看該作者
本帖最後由 singo1232001 於 2021-7-29 15:34 編輯

回復 7# wang077


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

test (4).zip (60.28 KB)

TOP

wang077

帖子
104 
主題
10 
精華
0 
積分
114 
點名
0  
作業系統
Windows 10 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2021-6-21 
最後登錄
2021-8-24 
13#
發表於 2021-7-29 16:30 | 只看該作者
回復 12# singo1232001
非常感謝大大
我會去研究看看的！

TOP

wang077

帖子
104 
主題
10 
精華
0 
積分
114 
點名
0  
作業系統
Windows 10 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2021-6-21 
最後登錄
2021-8-24 
14#
發表於 2021-7-29 16:32 | 只看該作者
本帖最後由 wang077 於 2021-7-29 16:35 編輯

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

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
15#
發表於 2021-7-29 18:33 | 只看該作者
回復 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 (47.47 KB)

2.PNG

TOP

wang077

帖子
104 
主題
10 
精華
0 
積分
114 
點名
0  
作業系統
Windows 10 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2021-6-21 
最後登錄
2021-8-24 
16#
發表於 2021-7-30 08:46 | 只看該作者
回復 15# samwang
大大，我有寄檔案到你的gmail
可以麻煩你看一下嗎，謝謝

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
17#
發表於 2021-7-30 11:33 | 只看該作者
回復 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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
18#
發表於 2021-7-30 12:22 | 只看該作者
回復 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

wang077

帖子
104 
主題
10 
精華
0 
積分
114 
點名
0  
作業系統
Windows 10 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2021-6-21 
最後登錄
2021-8-24 
19#
發表於 2021-7-30 15:54 | 只看該作者
回復 18# samwang
感謝大大幫忙，我有回信到你的mail喔！

TOP

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-2-15 
20#
發表於 2021-7-31 09:45 | 只看該作者
話說這種表單查詢有何做用???
若是因為表格橫寬及縱長太大, 想調出指定資料做修改,
那還是在原表操作較實在~~

TOP

        靜思自在 : 吃苦了苦、苦盡廿來，享福了福、福盡悲來。
123
返回列表 上一主題