Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%
'↑宣告變數:R是長整數變數,i是長整數變數,j是短整數變數
R = Sheets("主場").Cells(Rows.Count, "H").End(3).Row
'↑令R這長整數是 主場表H欄最後一個有內容的儲存格列號
For i = 2 To Sheets("樣板").Cells(Rows.Count, "H").End(3).Row '這外迴圈跑縱向(列)
'↑設外順迴圈!i從2 到 樣板表H欄最後一個有內容的儲存格列號
If Sheets("樣板").Cells(i, 8) <> "" Then
'↑如果樣板表的 i迴圈列H欄儲存格值 不是空字元??
R = R + 1
'↑在If條件成立後,必須令R累加1,
'因為符合條件的資料必須放在主場表的第一空列
For j = 1 To 8 '這內迴圈跑橫向(欄)
'↑設內順迴圈!j從1 到8
Sheets("主場").Cells(R, j) = Sheets("樣板").Cells(i, j)
'↑令主場表 R列j迴圈欄的儲存格值是 樣板表的 i迴圈列j迴圈欄儲存格值
Next
End If
Next
End Sub作者: av8d 時間: 2023-3-2 13:24
這是後學研究前輩方案的理解
Option Explicit
Private Sub CommandButton5_Click()
Dim i&, j&, k%
'↑宣告變數:(i,j)是長整數,k是短整數
For i = 2 To 100
'↑設順迴圈i從2 到100
If Sheets(2).Cells(i, 8) <> "" Then
'↑如果表2的i迴圈列H欄儲存格不是空字元??
j = 2
'↑令j變數是 2
JJ: If Sheets(1).Cells(j, 8) = "" Then
'↑如果表1的i迴圈列H欄儲存格是空格??
For k = 2 To 8
'↑設順迴圈k從2 到8
Sheets(1).Cells(j, k) = Sheets(2).Cells(i, k)
'↑令表1的j迴圈列k迴圈欄儲存格值是 表2的i變數列k迴圈欄儲存格值
Next
Else
'↑否則(表1的i迴圈列H欄儲存格不是空格)
j = j + 1
'↑就令j變數+1
GoTo JJ
'↑跳到 JJ標示的程序位置繼續執行
End If
End If
Next
End Sub
以下是另一個變數化的練習,請參考
Private Sub CommandButton5_Click()
Dim R&, R1&, i&, j%, Arr, Sh1 As Range, Sh2 As Range
Set Sh1 = Sheets("主場").Cells
Set Sh2 = Sheets("樣板").Cells
R = Sh1(65536, 8).End(3).Row
R1 = Sh2(65536, 8).End(3).Row
For i = 2 To R1
If Sh2(i, 8) <> "" Then
R = R + 1
For j = 1 To 8
Sh1(R, j) = Sh2(i, j)
Next
End If
Next
End Sub作者: Andy2483 時間: 2023-3-2 15:13
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr
Arr = Range([樣板!A1], [樣板!H65536].End(3))
For i = 2 To UBound(Arr)
If Arr(i, 8) <> "" Then
R = R + 1
For j = 1 To UBound(Arr, 2)
Arr(R, j) = Arr(i, j)
Next
End If
Next
[主場!H65536].End(3).Item(2, -6).Resize(R, UBound(Arr, 2)) = Arr
Set Arr = Nothing
End Sub作者: Andy2483 時間: 2023-3-2 15:37
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Y, A(1 To 8)
Set Y = CreateObject("Scripting.Dictionary")
Arr = Range([樣板!A1], [樣板!H65536].End(3))
For i = 2 To UBound(Arr)
If Arr(i, 8) = "" Then GoTo REAR
For j = 1 To UBound(Arr, 2)
A(j) = Arr(i, j)
Next
Y(Arr(i, 8)) = A
REAR: Next
[主場!H65536].End(3).Item(2, -6).Resize(Y.Count, UBound(A)) = _
Application.Transpose(Application.Transpose(Y.ITEMS))
Set Arr = Nothing: Set Y = Nothing: Erase A
End Sub
這是後學以H欄濾重複(取前略後) 練習字典的方案,請前輩參考
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Y, A(1 To 8)
Set Y = CreateObject("Scripting.Dictionary")
Arr = Range([樣板!A1], [樣板!H65536].End(3))
For i = 2 To UBound(Arr)
If Arr(i, 8) = "" Or Y.Exists(Arr(i, 8)) <> Empty Then GoTo REAR
For j = 1 To UBound(Arr, 2)
A(j) = Arr(i, j)
Next
Y(Arr(i, 8)) = A
REAR: Next
[主場!H65536].End(3).Item(2, -6).Resize(Y.Count, UBound(A)) = _
Application.Transpose(Application.Transpose(Y.ITEMS))
Set Arr = Nothing: Set Y = Nothing: Erase A
End Sub作者: Andy2483 時間: 2023-3-2 16:47
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Y, Brr, A
Set Y = CreateObject("Scripting.Dictionary")
Arr = Range([樣板!A1], [樣板!H65536].End(3))
For i = 2 To UBound(Arr)
If Arr(i, 8) <> "" Then Y(Arr(i, 8)) = i
Next
ReDim Brr(1 To Y.Count, 1 To 8)
For Each A In Y.Items
R = R + 1
For j = 1 To UBound(Arr, 2)
Brr(R, j) = Arr(A, j)
Next
Next
[主場!H65536].End(3).Item(2, -6).Resize(Y.Count, 8) = Brr
Set Arr = Nothing: Set Brr = Nothing: Set Y = Nothing
End Sub作者: Andy2483 時間: 2023-3-3 08:47
本帖最後由 Andy2483 於 2023-3-3 09:16 編輯
謝謝論壇,謝謝各位前輩
後學複習昨天的習題,複習心得如下,請指教
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, R1&, i&, j%, Arr, Sh1 As Range, Sh2 As Range
'↑宣告變數:(R,R1,i)是長整數變數,j是短整數變數,(Sh1,Sh2)是儲存格變數
Set Sh1 = Sheets("主場").Cells
'↑令Sh1這儲存格變數是 主場表的所有儲存格
Set Sh2 = Sheets("樣板").Cells
'↑令Sh2這儲存格變數是 樣板表的所有儲存格
R = Sh1(65536, 8).End(3).Row
'↑令R這長整數變數是 Sh1變數的H欄最後一個有內容的儲存格列號
R1 = Sh2(65536, 8).End(3).Row
'↑令R1這長整數變數是 Sh2變數的H欄最後一個有內容的儲存格列號
For i = 2 To R1
'↑設順迴圈!i從2 到R1變數
If Sh2(i, 8) <> "" Then
'↑如果Sh2變數的i迴圈列第8欄不是空格(如果樣板表的H欄i變數列儲存格不是空白)
R = R + 1
'↑令R變數累加1
For j = 1 To 8
'↑設順迴圈!j從1到 8
Sh1(R, j) = Sh2(i, j)
'↑令Sh1變數的R變數列第j變數欄儲存格值是 Sh2變數的i變數列第j變數欄儲存格值
Next
End If
Next
End Sub
====================================================
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr
'↑宣告變數:(R,i)是長整數變數,j是短整數變數,Arr是通用型變數
Arr = Range([樣板!A1], [樣板!H65536].End(3))
'↑令Arr這通用型變數是 樣板表[A1]到H欄最後一有內容儲存格,
'這兩個儲存格擴展出最小的方正範圍 儲存格值
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2 到Arr陣列縱向最大索引列號
If Arr(i, 8) <> "" Then
'↑如果i迴圈列第8欄Arr陣列值 不是空字元?
R = R + 1
'↑令R這長整數變數累加1
For j = 1 To UBound(Arr, 2)
'↑設順迴圈!j從1 到Arr陣列橫向最大索引欄號
Arr(R, j) = Arr(i, j)
'↑令R變數列第j欄的Arr陣列值是 i迴圈列第j欄的Arr陣列值
Next
End If
Next
[主場!H65536].End(3).Item(2, -6).Resize(R, UBound(Arr, 2)) = Arr
'↑令主場表H欄最後一有內容儲存格算起,往下1列,往左7欄的那一格開始擴展,
'擴展向下R列,向右擴展Arr陣列橫向最大索引欄號數欄,
'這擴展範圍儲存格值以Arr陣列值帶入
Set Arr = Nothing
'↑釋放變數
End Sub
====================================================
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Y, A(1 To 8)
'↑宣告變數:(R,i)是長整數變數,j是短整數變數,(Arr,Y)是通用型變數
'A是一維陣列(從1到8索引號)
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Arr = Range([樣板!A1], [樣板!H65536].End(3))
'↑令Arr這通用型變數是二維陣列,以樣板表[A1]到H欄最後一有內容儲存格,
'這範圍儲存格值倒入Arr陣列裡
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2 到Arr陣列縱向最大索引列號
If Arr(i, 8) = "" Then GoTo REAR
'↑如果i迴圈列第8欄Arr陣列值是 空字元!
'就跳到 REAR標示的程序位置繼續執行
For j = 1 To UBound(Arr, 2)
'↑設順迴圈!j從1 到Arr陣列橫向最大索引欄號數
A(j) = Arr(i, j)
'↑令j索引號A陣列值是 i迴圈列j迴圈欄Arr陣列值
Next
Y(Arr(i, 8)) = A
REAR: Next
[主場!H65536].End(3).Item(2, -6).Resize(Y.Count, UBound(A)) = _
Application.Transpose(Application.Transpose(Y.ITEMS))
'↑令主場表H欄最後一有內容儲存格算起,往下1列,往左7欄的那一格開始擴展,
'擴展向下Y字典裡Key數量 列,向右擴展A陣列最大索引號數欄,
'這擴展範圍儲存格值以Y字典的Item轉置兩次後帶入
Set Arr = Nothing: Set Y = Nothing: Erase A
'↑令釋放變數
End Sub
====================================================
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Y, A(1 To 8)
'↑宣告變數:(R,i)是長整數變數,j是短整數變數,(Arr,Y)是通用型變數
'A是一維陣列(從1到8索引號)
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Arr = Range([樣板!A1], [樣板!H65536].End(3))
'↑令Arr這通用型變數是二維陣列,以樣板表[A1]到H欄最後一有內容儲存格,
'這範圍儲存格值倒入Arr陣列裡
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2 到Arr陣列縱向最大索引列號
If Arr(i, 8) = "" Or Y.Exists(Arr(i, 8)) <> Empty Then GoTo REAR
'↑如果i迴圈列第8欄Arr陣列值是 空字元!
'或以i迴圈列第8欄Arr陣列值為key查Y字典,查得到這key已經存在!
'就跳到 REAR標示的程序位置繼續執行
For j = 1 To UBound(Arr, 2)
'↑設順迴圈!j從1 到Arr陣列橫向最大索引欄號數
A(j) = Arr(i, j)
'↑令j索引號A陣列值是 i迴圈列j迴圈欄Arr陣列值
Next
Y(Arr(i, 8)) = A
REAR: Next
[主場!H65536].End(3).Item(2, -6).Resize(Y.Count, UBound(A)) = _
Application.Transpose(Application.Transpose(Y.ITEMS))
'↑令主場表H欄最後一有內容儲存格算起,往下1列,往左7欄的那一格開始擴展,
'擴展向下Y字典裡Key數量 列,向右擴展A陣列最大索引號數欄,
'這擴展範圍儲存格值以Y字典的Item轉置兩次後帶入
Set Arr = Nothing: Set Y = Nothing: Erase A
'↑令釋放變數
End Sub
====================================================
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Brr, Y, A
'↑宣告變數:(R,i)是長整數變數,j是短整數變數,
'(Arr,Brr,Y,A)是通用型變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Arr = Range([樣板!A1], [樣板!H65536].End(3))
'↑令Arr這通用型變數是二維陣列,以樣板表[A1]到H欄最後一有內容儲存格,
'這範圍儲存格值倒入Arr陣列裡
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2 到Arr陣列縱向最大索引列號
If Arr(i, 8) <> "" Then Y(Arr(i, 8)) = i
'↑如果i迴圈列第8欄Arr陣列值不是空字元!就以這陣列值當key,
'Item是i變數,放入Y字典裡
Next
ReDim Brr(1 To Y.Count, 1 To 8)
'↑宣告Brr變數是二維陣列!陣列大小範圍:縱向1索引號列到(Y字典key數)索引號列,
'橫向從1索引號欄到8索引號欄
For Each A In Y.Items
'↑設順迴圈!令A是Y字典裡Item的一員
R = R + 1
'↑令R這長整數變數累加1
For j = 1 To UBound(Arr, 2)
'↑設順迴圈!j從1 到Arr陣列橫向最大索引欄號
Brr(R, j) = Arr(A, j)
'↑令R變數列j變數欄Brr陣列值是 A變數列j欄Arr陣列值
Next
Next
[主場!H65536].End(3).Item(2, -6).Resize(Y.Count, 8) = Brr
'↑令主場表H欄最後一有內容儲存格算起,往下1列,往左7欄的那一格開始擴展,
'擴展向下Y字典裡Key數量 列,向右擴展8欄,
'這擴展範圍儲存格值以Brr陣列值帶入
Set Arr = Nothing: Set Brr = Nothing: Set Y = Nothing
'↑釋放變數
End Sub作者: av8d 時間: 2023-3-3 12:24
