[發問] 資料套表

PJChen

大大好,

塑板工作表要套用資料,請問程式怎麼寫? 資料套表.rar (21.47 KB)

下載次數: 9

2021-9-28 17:30

"預約"工作表資料會一直增加,
"預約"工作表O欄="V",則
1. 日期：塑板的C17="預約"A欄
2. 數量：塑板的E22 ="預約"C欄
3. 客戶：塑板的C16 = 說明K:N取相同客戶資料
4. 承辦：塑板的C26 = 說明K:N取相同客戶資料
5. 電話：塑板的C27 = 說明K:N取相同客戶資料
6. 填表日：塑板的C28 = 說明K:N取相同客戶資料

完成後將塑板工作表單獨
另存路徑 D:\佳-20210929 (日期YYYYMMDD,與1.相同)

Ex: "預約"工作表O6="V"=佳
則塑板工作表填入
1. 日期：塑板的C17=2021/9/29
2. 數量：塑板的E22 =120
3. 客戶：塑板的C16 = 暫代4
4. 承辦：塑板的C26 = 代稱4
5. 電話：塑板的C27 = 電話4
6. 填表日：塑板的C28 = 當天日期=2021/9/28

samwang

回復 1# PJChen

請測試看看，謝謝
Sub test()
Dim Arr, Brr, i&, C%
Arr = Range([預約!o1], [預約!a65536].End(3))
Brr = Sheets("說明").[j1].CurrentRegion
Tm = Timer
For i = 2 To UBound(Arr)
    If UCase(Arr(i, 15)) = "V" Then
        With Sheets("塑板")
            .[c17] = Arr(i, 1): .[e22] = Arr(i, 3): .[c28] = Date
            For j = 2 To UBound(Brr)
                If Arr(i, 2) = Brr(1, j) Then
                .[c16] = Brr(2, j): .[c26] = Brr(3, j): .[c27] = Brr(4, j)
                End If
            Next
        End With
        C = 1: Exit For
    End If
Next
If C = 1 Then
    Application.DisplayAlerts = False
    Sheets("塑板").Copy
    ActiveWorkbook.SaveAs "D:\" & "佳-" & Format(Date, "yyyymmdd") & ".xlsx"
    ActiveWindow.Close
    Application.DisplayAlerts = True
    With Sheets("塑板")
        .[c17] = "": .[e22] = "": .[c28] = ""
        .[c16] = "": .[c26] = "": .[c27] = ""
    End With
End If
MsgBox Timer - Tm
End Sub

PJChen

回復 2# samwang
您好,
程式有點小修改,不知為何,套用在"佳",資料就不完整,
已經查找了一個小時,還是找不到原因,可否幫忙看下？
請用我修改過的資料試試.... 資料套表.rar (21.33 KB)

下載次數: 5

2021-9-30 01:29

samwang

回復 3# PJChen


不好意思，我測試沒問題，可否請在明確說明您的問題哪裡?
謝謝

PJChen

回復 4# samwang
您好,
我用上傳這個檔,把有問題的套表資料留在那,請幫我看下 資料套表.rar (21.38 KB)

下載次數: 3

2021-9-30 20:24

我反覆測試, 將資料做調換,發現"說明"工作表中的O欄後的資料帶不出來！
如果你run的結果是沒問題的,那到底原因為何?有法改善嗎?

samwang

回復 5# PJChen

那到底原因為何?有法改善嗎?
>> 不好意思，造成您的困擾，我的粗心大意，已更新如附件，謝謝
For j = 2 To UBound(Brr, 2)
(Brr,2)橫向(欄col)找資料
(Brr)直向(列row)找資料

PJChen

回復 6# samwang

For j = 2 To UBound(Brr, 2)
(Brr,2)橫向(欄col)找資料
(Brr)直向(列row)找資料

執行沒問題了,非常感謝說明！

PJChen

回復 6# samwang
Sam, 您好
請問...我想讓套表動作可以一次連續完成多張表格,
O欄不一定為連續"V"
如何讓所有"V"
連續做套表動作,直到完成？
資料套表.rar (19.61 KB)

下載次數: 9

2021-12-5 08:41

samwang

回復 8# PJChen

如何讓所有"V"
連續做套表動作,直到完成？
>> 請測試看看，謝謝

Sub test()
Dim Arr, Brr, i&, C%
Tm = Timer
Application.DisplayAlerts = False
Brr = Sheets("說明").[j1].CurrentRegion
Arr = Range([預約!o1], [預約!a65536].End(3))
With Sheets("塑板")
    .[c17] = "": .[e22] = "": .[c28] = ""
    .[c16] = "": .[c26] = "": .[c27] = ""
End With
For i = 2 To UBound(Arr)
    If UCase(Arr(i, 15)) = "V" Then
        With Sheets("塑板")
            .[c17] = Arr(i, 1): .[e22] = Arr(i, 3): .[c28] = Date 'Arr(i, 1)=日期,Arr(i, 3)=數量
            For j = 2 To UBound(Brr, 2)
                If Arr(i, 2) = Brr(1, j) Then
                .[c16] = Brr(2, j): .[c26] = Brr(3, j): .[c27] = Brr(4, j)
                End If
            Next
        End With
        Sheets("塑板").Copy
        ActiveWorkbook.SaveAs "D:\" & Arr(i, 2) & "-" & Format(Arr(i, 1), "yyyymmdd") & ".xlsx"
        ActiveWindow.Close
        With Sheets("塑板")
            .[c17] = "": .[e22] = "": .[c28] = ""
            .[c16] = "": .[c26] = "": .[c27] = ""
        End With
    End If
Next
MsgBox Timer - Tm
Application.DisplayAlerts = True
End Sub