Excel VBA 請益 II
[attach]33739[/attach][attach]33740[/attach]
AA表單C1為下拉式選單,裡面有三個圖示想做成按鈕,分別對應QQ表單的T1 & T2 & T3資料。
主要是今天想在QQ表單的T1資料,輸入數據,然後只要從AA表單按T1的按鈕,就能直接輸入數據,而不必跳到QQ表單內然後輸入資料。
在此提供檔案。
[attach]33741[/attach] [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116169&ptid=23275]1#[/url] [i]zz0660[/i] [/b]
是這樣嗎?
Sub test_T1()
Dim Arr, T, T1, i&, j&
T = Sheets("AA").Range("c1")
Ar = Sheets("AA").Range("b3:i19")
With Sheets("QQ")
Arr = .Range("a1:h" & .[b65536].End(3).Row) 'T1 T1,T2,T3請自行選擇更換
'Arr = .Range("j1:q" & .[k65536].End(3).Row) 'T2
'Arr = .Range("s1:z" & .[t65536].End(3).Row) 'T3
For i = 1 To UBound(Arr) Step 19
T1 = Arr(i, 2): If T1 = "" Then GoTo 99
If T1 = T Then
.Cells(i, 1).Offset(1).Resize(16, 8).Value = Ar
Exit Sub
End If
99: Next
End With
End Sub [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116221&ptid=23275]2#[/url] [i]samwang[/i] [/b]
程式可以,但今天想把按鈕換成下拉式選單的方式呈現,如C1 & D1 個別為下拉式選單。
[attach]33775[/attach]
請問該如何修改呢?,謝謝! [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116221&ptid=23275]2#[/url] [i]samwang[/i] [/b]
Sub test_T1()
Dim Arr, T,U ,T1, i&, j&
T = Sheets("AA").Range("c1")
U = Sheets("AA").Range("d1")
Ar = Sheets("AA").Range("b3:i19")
With Sheets("QQ")
Arr = .Range("a1:h" & .[b65536].End(3).Row) 'T1 T1,T2,T3請自行選擇更換
'Arr = .Range("j1:q" & .[k65536].End(3).Row) 'T2
'Arr = .Range("s1:z" & .[t65536].End(3).Row) 'T3
For i = 1 To UBound(Arr) Step 19
T1 = Arr(i, 2): If T1 = "" Then GoTo 99
If T1 = T Then
.Cells(i, 1).Offset(1).Resize(16, 8).Value = Ar
Exit Sub
End If
99: Next
End With
End Sub
接下來就不知道怎麼用,不知道是不是這樣改。 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116266&ptid=23275]4#[/url] [i]zz0660[/i] [/b]
不好意思,可否請解釋詳細一點,謝謝 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116267&ptid=23275]5#[/url] [i]samwang[/i] [/b]
您好,現在想把按鈕換成下拉式選單的方式,當d1欄位讀取到選單內容為T1,就會顯示QQ表單的相對應位置。 [i=s] 本帖最後由 samwang 於 2021-7-29 07:28 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116275&ptid=23275]6#[/url] [i]zz0660[/i] [/b]
請測試看看,謝謝
Sub test_T1()
Dim Arr, T, xR, T1, i&, j&, xC%
With Sheets("AA")
T = .Range("c1"): xR = .Range("d1")
Ar = .Range("b3:i19")
End With
With Sheets("QQ")
If xR = "T1" Then
Arr = .Range("a1:h" & .[b65536].End(3).Row): xC = 0 'T1
ElseIf xR = "T2" Then
Arr = .Range("j1:q" & .[k65536].End(3).Row): xC = 9 'T2
ElseIf xR = "T3" Then
Arr = .Range("s1:z" & .[t65536].End(3).Row): xC = 18 'T3
End If
For i = 1 To UBound(Arr) Step 19
T1 = Arr(i, 2): If T1 = "" Then GoTo 99
If T1 = T Then
.Cells(i, 1).Offset(1, xC).Resize(17, 8).Value = Ar
Exit Sub
End If
99: Next
End With
End Sub [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116289&ptid=23275]7#[/url] [i]samwang[/i] [/b]
感謝您協助處理問題,目前使用該程式碼,沒有任何反應,在此提供檔案。
[attach]33791[/attach]
麻煩您了,謝謝! [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116316&ptid=23275]8#[/url] [i]zz0660[/i] [/b]
我測試沒問題如附件,可否再講詳細一點,謝謝 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116322&ptid=23275]9#[/url] [i]samwang[/i] [/b]
請問您把程式碼放在哪裡?
[attach]33801[/attach]
是AA工作表,還是另外開一個模組呢? [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116332&ptid=23275]10#[/url] [i]zz0660[/i] [/b]
我用你8樓的附件那個檔案測試,一般模組和工作表都沒問題,請再確認,謝謝 [i=s] 本帖最後由 Andy2483 於 2023-5-31 15:07 編輯 [/i]
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習8#樓範例方案如下,請各位前輩指教
AA表執行前:
[attach]36480[/attach]
載至AA表_執行結果:
[attach]36481[/attach]
AA表_使用者執行儲存格編輯:
[attach]36482[/attach]
寫入QQ表_執行結果:
[attach]36483[/attach]
Option Explicit
Public K%
Sub TEST()
Dim Qrr, Arr, Y, Z, i&, j&, T1$, T2$, TT$
Dim Q As Range, A As Range, Shq As Worksheet, Sha As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sha = Sheets("AA"): Set Shq = Sheets("QQ")
Set Q = Range(Shq.[A1], Shq.UsedRange): Qrr = Q
For i = 1 To UBound(Qrr, 1) Step 19
For j = 2 To UBound(Qrr, 2) Step 9
T1 = Qrr(i, j): T2 = Qrr(i, j + 1): TT = T1 & "|" & T2
If T1 = "" Or T2 = "" Then GoTo j01
Set Y(TT) = Range(Q(i, j - 1), Q(i + 18, j + 7))
Y(TT & "|v") = Y(TT)
j01: Next
Next
Set A = Sha.[B1:J19]: Arr = A
T1 = Arr(1, 2): T2 = Arr(1, 3): TT = T1 & "|" & T2
If K = 1 Then A = Y(TT & "|v")
If K = 2 Then Set Q = Y(TT): Q = Arr
Set Y = Nothing: Set Q = Nothing: Set A = Nothing
Set Sha = Nothing: Set Shq = Nothing: Erase Qrr, Arr
End Sub
'================================
Sub 載至AA表()
K = 1: Call TEST
End Sub
'================================
Sub 寫入QQ表()
K = 2: Call TEST
End Sub
頁:
[1]