麻辣家族討論版版's Archiver

PJChen 發表於 2021-9-28 17:31

資料套表

大大好,

塑板工作表要套用資料,請問程式怎麼寫? [attach]34080[/attach]
"預約"工作表資料會一直增加,
"預約"工作表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 發表於 2021-9-29 07:42

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117022&ptid=23383]1#[/url] [i]PJChen[/i] [/b]

請測試看看,謝謝
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 發表於 2021-9-30 01:29

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117035&ptid=23383]2#[/url] [i]samwang[/i] [/b]
您好,
程式有點小修改,不知為何,套用在"佳",資料就不完整,
已經查找了一個小時,還是找不到原因,可否幫忙看下?
請用我修改過的資料試試.... [attach]34092[/attach]

samwang 發表於 2021-9-30 08:00

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117051&ptid=23383]3#[/url] [i]PJChen[/i] [/b]


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

PJChen 發表於 2021-9-30 20:27

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117054&ptid=23383]4#[/url] [i]samwang[/i] [/b]
您好,
我用上傳這個檔,把有問題的套表資料留在那,請幫我看下 [attach]34102[/attach]
我反覆測試, 將資料做調換,發現"說明"工作表中的O欄後的資料帶不出來!
如果你run的結果是沒問題的,那到底原因為何?有法改善嗎?

samwang 發表於 2021-10-1 07:41

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117071&ptid=23383]5#[/url] [i]PJChen[/i] [/b]

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

PJChen 發表於 2021-10-1 19:31

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117073&ptid=23383]6#[/url] [i]samwang[/i] [/b]

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

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

PJChen 發表於 2021-12-5 08:42

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117073&ptid=23383]6#[/url] [i]samwang[/i] [/b]
Sam, 您好
請問...我想讓套表動作可以一次連續完成多張表格,
O欄不一定為連續"V"
如何讓所有"V"
連續做套表動作,直到完成?
[attach]34460[/attach]

samwang 發表於 2021-12-6 07:37

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117913&ptid=23383]8#[/url] [i]PJChen[/i] [/b]

如何讓所有"V"
連續做套表動作,直到完成?
[color=Blue]>> 請測試看看,謝謝[/color]

[color=Blue]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
[/color]

頁: [1]

麻辣家族討論版版為 麻辣學園 網站成員  由 昱得資訊工作室 © Since 1993 所提供