資料套表
大大好,塑板工作表要套用資料,請問程式怎麼寫? [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 [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 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117035&ptid=23383]2#[/url] [i]samwang[/i] [/b]
您好,
程式有點小修改,不知為何,套用在"佳",資料就不完整,
已經查找了一個小時,還是找不到原因,可否幫忙看下?
請用我修改過的資料試試.... [attach]34092[/attach] [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117051&ptid=23383]3#[/url] [i]PJChen[/i] [/b]
不好意思,我測試沒問題,可否請在明確說明您的問題哪裡?
謝謝 [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的結果是沒問題的,那到底原因為何?有法改善嗎? [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] [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)找資料
執行沒問題了,非常感謝說明! [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] [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]