zz0660

帖子: 50
主題: 15
精華: 0
積分: 75
點名: 1
作業系統: WIN10
軟體版本: Office 2010
閱讀權限: 20
性別: 男
註冊時間: 2021-7-21
最後登錄: 2024-6-14

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2021-7-24 16:54 | 只看該作者

Excel VBA 請益 II

AA表單C1為下拉式選單，裡面有三個圖示想做成按鈕，分別對應QQ表單的T1 & T2 & T3資料。
主要是今天想在QQ表單的T1資料，輸入數據，然後只要從AA表單按T1的按鈕，就能直接輸入數據，而不必跳到QQ表單內然後輸入資料。

在此提供檔案。

BTT.rar (26.55 KB)

樓主熱帖

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-12-18

2^#

發表於 2021-7-26 07:46 | 只看該作者

回復 1# zz0660

是這樣嗎?

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

TOP

zz0660

中學生 Rank: 2

帖子: 50
主題: 15
精華: 0
積分: 75
點名: 1
作業系統: WIN10
軟體版本: Office 2010
閱讀權限: 20
性別: 男
註冊時間: 2021-7-21
最後登錄: 2024-6-14

3^#

發表於 2021-7-28 09:53 | 只看該作者

回復 2# samwang

程式可以，但今天想把按鈕換成下拉式選單的方式呈現，如C1 & D1 個別為下拉式選單。

請問該如何修改呢?，謝謝!

TOP

zz0660

中學生 Rank: 2

帖子: 50
主題: 15
精華: 0
積分: 75
點名: 1
作業系統: WIN10
軟體版本: Office 2010
閱讀權限: 20
性別: 男
註冊時間: 2021-7-21
最後登錄: 2024-6-14

4^#

發表於 2021-7-28 10:04 | 只看該作者

回復 2# samwang

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

接下來就不知道怎麼用，不知道是不是這樣改。

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-12-18

5^#

發表於 2021-7-28 10:44 | 只看該作者

回復 4# zz0660

不好意思，可否請解釋詳細一點，謝謝

TOP

zz0660

中學生 Rank: 2

帖子: 50
主題: 15
精華: 0
積分: 75
點名: 1
作業系統: WIN10
軟體版本: Office 2010
閱讀權限: 20
性別: 男
註冊時間: 2021-7-21
最後登錄: 2024-6-14

6^#

發表於 2021-7-28 13:13 | 只看該作者

回復 5# samwang

您好，現在想把按鈕換成下拉式選單的方式，當d1欄位讀取到選單內容為T1，就會顯示QQ表單的相對應位置。

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-12-18

7^#

發表於 2021-7-29 07:26 | 只看該作者

本帖最後由 samwang 於 2021-7-29 07:28 編輯

回復 6# zz0660

請測試看看，謝謝
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

TOP

zz0660