返回列表 上一主題 發帖

EXCEL 自動加入表格

回復 1# sschristy


    謝謝前輩發表此主題與情境
建議上傳個範例
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 3# sschristy


    http://forum.twbts.com/viewthread.php?tid=34&extra=page%3D1
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 1# sschristy


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


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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 Andy2483 於 2023-10-14 12:44 編輯

回復 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)
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 Andy2483 於 2023-10-24 07:26 編輯

回復 13# sschristy


Private Sub CommandButton2_Click()
Dim xA As Range, xB As Range, xI As Range
Set xA = Range([A1], ActiveSheet.UsedRange)
Set xB = [A:G]
Set xI = Intersect(xA, xB)
xI.Offset(3, 0).ClearContents
End Sub

https://learn.microsoft.com/zh-t ... worksheet.usedrange
https://learn.microsoft.com/zh-t ... plication.intersect
https://learn.microsoft.com/zh-t ... /excel.range.offset
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 Andy2483 於 2023-10-25 07:45 編輯

回復 13# sschristy


    以下是複習的心得註解,請前輩參考

Private Sub CommandButton2_Click()
Dim xA As Range, xB As Range, xI As Range
'↑宣告(xA,xB,xI)各是儲存格變數
Set xA = Range([A1], ActiveSheet.UsedRange)
'↑令xA這儲存格變數是涵蓋[A1]儲存格與此表已使用儲存格,
'涵蓋這區間的最小方正範圍儲存格

Set xB = [A:G]
'↑令xB這儲存格變數是[A:G]儲存格
Set xI = Intersect(xA, xB)
'↑令xI這儲存格變數是 xA與xB變數交集的儲存格
xI.Offset(3, 0).ClearContents
'↑令xI變數往下偏移3列的這新範圍儲存格清除其內容
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 16# sschristy


    以下是批次刪除選取的列資料(選取格列攔>按鈕) 或 全部列資料刪除(整表選取>按鈕)

Private Sub CommandButton2_Click()
Dim Q, A$, i&, n&, xI As Range, Brr, xA As Range, xB As Range
Set xA = Selection.Cells: Set xB = ActiveSheet.UsedRange
If xA.EntireRow.Count > xB.Rows.Count Then Set xA = Intersect(xA, xB)
If xA Is Nothing Then Exit Sub
Set xI = Intersect(Range([A1], xB), [A:G]): Brr = xI
For Each Q In Split(xA.EntireRow.Address(0, 0), ",")
   For i = Split(Q, ":")(0) To Split(Q, ":")(1)
      A = IIf(A = "", "/" & Val(i) & "/", A & Val(i) & "/")
   Next
Next
For i = 4 To xI.Rows.Count
   If InStr(A, "/" & i & "/") Then GoTo i01 Else n = n + 1
   For j = 1 To UBound(Brr, 2): Brr(n, j) = Brr(i, j): Next
i01: Next
xI.Offset(3, 0).ClearContents
If n = 0 Then Exit Sub
[A4].Resize(n, UBound(Brr, 2)) = Brr
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 Andy2483 於 2023-10-25 15:01 編輯

回復 16# sschristy


    以下另一方法,請前輩參考
Private Sub CommandButton2_Click()
Dim xU As Range, xA As Range, xB As Range
Set xA = Selection.Cells: Set xB = ActiveSheet.UsedRange.Offset(3)
Set xU = Union(xA, xB)
If xU.Count <> xB.Count Then Exit Sub
Intersect(xA.EntireRow, [A:G]).Delete Shift:=xlUp
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 有多少力量就做多少事,不要心存等待,等待才會落空。
返回列表 上一主題