返回列表 上一主題 發帖

[發問] 為何只抓到第一筆資料

[發問] 為何只抓到第一筆資料

只抓到第一筆資料.rar (55.44 KB)


嘗試撰寫兩個題目,努力網路查詢研究中,前輩有空還請過目,感謝

Private Sub CommandButton5_Click()
    For i = 2 To 10
        If Sheets(2).Cells(i, 8) <> "" Then
            For j = 2 To 10
               
                If Sheets(1).Cells(j, 8) = "" Then
                    Sheets(1).Cells(j, 2) = Sheets(2).Cells(j, 2)
                    Sheets(1).Cells(j, 3) = Sheets(2).Cells(j, 3)
                    Sheets(1).Cells(j, 4) = Sheets(2).Cells(j, 4)
                    Sheets(1).Cells(j, 5) = Sheets(2).Cells(j, 5)
                    Sheets(1).Cells(j, 6) = Sheets(2).Cells(j, 6)
                    Sheets(1).Cells(j, 7) = Sheets(2).Cells(j, 7)
                    Sheets(1).Cells(j, 8) = Sheets(2).Cells(j, 8)
                End If
            Next
        End If
    Next
End Sub
試試看
杜小平

TOP

本帖最後由 av8d 於 2023-3-2 10:59 編輯

回復 2# dou10801

謝謝前輩,長的幾乎一模一樣卻有前後差異,我帶回去好好研究一下。
(原來是我把i打成j尷尬了,感謝)

TOP

本帖最後由 Andy2483 於 2023-3-2 11:43 編輯

回復 1# av8d


    謝謝前輩們
後學研究學習此情境的解決方案如下,請前輩參考

執行前:
2023-03-02_112549.JPG
2023-3-2 11:31


執行結果:
2023-03-02_112600.JPG
2023-3-2 11:32


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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

本帖最後由 av8d 於 2023-3-2 13:37 編輯

回復 4# Andy2483


謝謝前輩,您給的答案正是我要的,而且撰寫的更簡單(日後我會朝這方向邁進),受益良多,
我剛又修改了一下,附上我撰寫(但較為攏長的)。

只抓到第一筆資料(已完成).rar (57.07 KB)

TOP

本帖最後由 Andy2483 於 2023-3-2 14:43 編輯

回復 5# av8d


    謝謝前輩回復一起學習
1.前輩自學的邏輯與結果對了就很好了,短不一定是最好的,因為對情境的猜測理解都因人而異
2.自動擴充.濾重複.防錯..等等都是後學想學習的
3.建議前輩養成宣告變數的習慣,有很多好處

這是後學研究前輩方案的理解
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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

回復 1# av8d


    這是後學練習陣列的方案,請參考

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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

本帖最後由 Andy2483 於 2023-3-2 15:52 編輯

回復 1# av8d


    這是後學以H欄濾重複(捨前取後) 練習字典的方案,請前輩參考

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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

回復 1# av8d

謝謝前輩發表此主題與範例
可以練習很多方法,以下是字典先濾H欄重複值,Item是列號
最後以Item引導陣列帶入另二維陣列

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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

本帖最後由 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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

        靜思自在 : 不要隨心所欲,要隨心教育自己。
返回列表 上一主題