EXCEL 自動加入表格

sschristy

請問各位前輩，我想要利用核取方塊將需要的內容勾選，如圖1中第3、4列勾選，點選右邊的"加入主表格"按鈕後，
讓這兩列表格內的文字自動加到"主表格"中，請問是否有辦法實現呢？

下載 (16.52 KB)

2023-10-2 15:31

下載 (16.79 KB)

2023-10-2 15:31

Andy2483

回復 1# sschristy


    謝謝前輩發表此主題與情境
建議上傳個範例

sschristy

回復 2# Andy2483


   抱歉，請問該如何上傳EXCEL檔案？

Andy2483

回復 3# sschristy


    http://forum.twbts.com/viewthread.php?tid=34&extra=page%3D1

sschristy

感謝大大回覆，目前等級仍太低，無法貼檔案，會努力提升等級，謝謝

julianwic

我也是積分不足無法發文，目前每天努又簽到中 XD

Andy2483

回復 1# sschristy


    猜測情境:
以篩選出需求資料加入主表格
20231006.zip (21.7 KB)

下載次數: 4

2023-10-6 16:12

Option Explicit
Sub 加入主表格()
Dim Crr(1 To 100, 1 To 6), Q, i&, j%, A, n&
Dim sh1 As Worksheet, sh2 As Worksheet, Frng As Range
For Each Q In Worksheets
   If Q.[F1] = "建議廠牌" Then Set sh1 = Q
   If Q.[G3] = "建議廠牌" Then Set sh2 = Q
Next
A = Array(1, 2, 4, 5, 6)
With sh1: .Activate
   If .AutoFilter Is Nothing Then
      .[A2].AutoFilter
      With ActiveWindow
         .FreezePanes = False: .SplitRow = 1: .FreezePanes = True
      End With
   End If
   If .[B65536].End(3).Row = 1 Then MsgBox "沒有資料": Exit Sub
   For i = 2 To .[B65536].End(3).Row
      If Rows(i).EntireRow.Hidden = True Then GoTo i02
      n = n + 1
      For j = 0 To 4
         Crr(n, A(j)) = Cells(i, j + 2)
      Next
i02: Next
End With
With sh2.[B65536].End(3)(2).Resize(n, 6)
   .Value = Crr
   sh2.Activate
   .Select
End With
Set sh1 = Nothing: Set sh2 = Nothing: Set Frng = Nothing: Erase Crr
End Sub

Sub 清除項目()
Dim Q
For Each Q In Worksheets
   If Q.[G3] = "建議廠牌" Then Q.UsedRange.Offset(3, 0).EntireRow.Delete: Exit Sub
Next
End Sub

sschristy

Public wst As String
Public j As Integer
Sub test()
Dim i As Integer
For i = 4 To 9999
If (Sheets("主表格").Range("A" & i) = "" And Sheets("主表格").Range("B" & i) = "") Then
Sheets("主表格").Range("B" & i) = Sheets(wst).Range("B" & j)
Sheets("主表格").Range("C" & i) = Sheets(wst).Range("C" & j)
Sheets("主表格").Range("E" & i) = Sheets(wst).Range("D" & j)
Sheets("主表格").Range("F" & i) = Sheets(wst).Range("E" & j)
Sheets("主表格").Range("G" & i) = Sheets(wst).Range("F" & j)
Exit For
Else
End If
Next i
Sheets("主表格").Activate
End Sub
------------------------------------------------------------------------

Private Sub CommandButton1_Click()
wst = "參考表1"
j = ActiveCell.Row
Application.Run "Module1.test"
End Sub
-------------------------------------------------------
前輩大大，這是按鈕內的程式碼，目前的方式是被選取到的那一行就會自動加入到主表格
但想要更改為可以批次加入，不知有沒有好方法，謝謝

Andy2483

回復 7# Andy2483

複習,修正與註解
Option Explicit
Sub 加入主表格()
Dim Crr(1 To 100, 1 To 6), Q, i&, j%, A, n&
'↑宣告Crr變數是二維陣列縱向範圍1到 100,橫向範圍從1到 6
'(Q,A)是通用型變數,(i,n)是長整數,j是短整數
Dim sh1 As Worksheet, sh2 As Worksheet, Frng As Range
'↑宣告(sh1,sh2)是工作表變數,Frng是儲存格變數
For Each Q In Worksheets
'↑設逐項迴圈!令Q是活頁簿中的工作表
   If Q.[F1] = "建議廠牌" Then Set sh1 = Q
   '↑如果工作表中的[F1]儲存格值是"建議廠牌"!就令sh1變數是工作表Q
   If Q.[G3] = "建議廠牌" Then Set sh2 = Q
   '↑如果工作表中的[G3]儲存格值是"建議廠牌"!就令sh2變數是工作表Q
Next
A = Array(1, 2, 4, 5, 6)
'↑令A變數是一維陣列,0~4索引號陣列值依序是(1, 2, 4, 5, 6)
With sh1: .Activate
'↑以下是關於工作表sh1的程序
'↑令激活該工作表
   If .AutoFilter Is Nothing Then
   '↑如果工作表沒有篩選的功能?
      .[A2].AutoFilter
      '↑令該表從該表[A2]儲存格建立篩選功能
      With ActiveWindow
      '↑以下是關於視窗的程序
         .FreezePanes = False: .SplitRow = 1: .FreezePanes = True
         '↑令凍結視窗解除,第1列分割視窗:令凍結視窗
      End With
   End If
   If .[B65536].End(3).Row = 1 Then MsgBox "沒有資料": Exit Sub
   '↑如果該表B欄最後有內容儲存格列號是1? True就跳出提視窗,結束程式執行
   For i = 2 To .[B65536].End(3).Row
   '↑設順迴圈!i從2到該表B欄最後有內容儲存格列號
      If .Rows(i).EntireRow.Hidden = True Then GoTo i02
      '↑如果該列是隱藏的!就跳到標示i02位置繼續執行
      n = n + 1
      '↑令n變數累加1
      For j = 0 To 4
      '↑設順迴圈!j從0到 4
         Crr(n, A(j)) = Cells(i, j + 2)
         '↑令n變數列(j變數A陣列值)欄的Crr陣列值是i變數列j變數+2欄儲存格值
      Next
i02: Next
End With
With sh2.[B65536].End(3)(2).Resize(n, 6)
'↑以下是關於工作表sh2從下往上找到的B欄第1個空白格向下擴展n變數列,
'向右擴展6欄儲存格的程序
   .Value = Crr
   '↑令儲存格值以Crr陣列值帶入
   sh2.Activate
   '↑令激活工作表
   .Select
   '↑令選取該範圍儲存格
End With
Set sh1 = Nothing: Set sh2 = Nothing: Set Frng = Nothing: Erase Crr
'↑令釋放變數
End Sub

Sub 清除項目()
Dim Q
For Each Q In Worksheets
   If Q.[G3] = "建議廠牌" Then Q.UsedRange.Offset(3, 0).EntireRow.Delete: Exit Sub
Next
'↑令結果表清除第3列以後的資料(含)
End Sub

Andy2483

回復 8# sschristy


    '以下是參考表1 選取多列 批次加入的建議方案
Private Sub CommandButton1_Click()
Dim Q, A(10000), i&, n&
wst = "參考表1"
For Each Q In Split(Selection.Cells.EntireRow.Address(0, 0), ",")
   For i = 0 To -Evaluate(Replace(Q, ":", "-"))
      A(n) = Val(Q) + i
      n = n + 1
   Next
Next
For i = 0 To n - 1
   j = A(i)
   Application.Run "Module1.test"
Next
Sheets("主表格").Activate
End Sub

20231014.zip (30.85 KB)

下載次數: 6

2023-10-14 12:44