返回列表 上一主題 發帖

[發問] 複製符合條件整列資料

[發問] 複製符合條件整列資料

複製符合條件整列資料
1. 條件:B欄值=ABC or QWE及C欄值=AA or BB及E欄值不等於空格
2. 將「工作表1」符合條件整列資料複製到「工作表2」
3. 「工作表2」資料依據A欄值排序,由小到大。
敬請指導
謝謝
AB.rar (8.89 KB)
100 字節以內
不支持自定義 Discuz! 代碼

回復 1# b9208
  1. Sub ex()
  2. Dim A As Range, Rng As Range
  3. With 工作表1
  4. Set Rng = .[A1:G1]
  5. For Each A In .Range("E:E").SpecialCells(xlCellTypeConstants)
  6.   If (A.Offset(, -3) = "ABC" Or A.Offset(, -3) = "QWE") And (A.Offset(, -2) = "AA" Or A.Offset(, -2) = "BB") Then Set Rng = Union(Rng, A.Offset(, -4).Resize(, 7))
  7. Next
  8. With 工作表2
  9. .Range(.[A3], .[A3].End(xlDown).Offset(, 6)).Clear
  10. Rng.Copy .[A3]
  11. .Range(.[A3], .[A3].End(xlDown).Offset(, 6)).Sort key1:=.[A3], Header:=xlYes
  12. End With
  13. End With
  14. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 2# Hsieh
Dear Hsieh
非常感謝您的指導
執行上沒有問題
:)
100 字節以內
不支持自定義 Discuz! 代碼

TOP

回復 2# Hsieh 請教版主,如果是[日期區段](工作表3),如何處理,感恩.

AB1.rar (17.98 KB)

杜小平

TOP

回復 4# dou10801

是這樣嗎? 請測試看看,謝謝

Sub test()
Dim Arr, T1, T2
With 工作表3
    Set Rng = .[A1:G1]
    T1 = .[j2]: T2 = .[k2]
    Arr = .Range(.[a1], .[g65536].End(3))
    For i = 2 To UBound(Arr)
        If Arr(i, 2) >= T1 And Arr(i, 2) <= T2 Then
        Set Rng = Union(Rng, .Cells(i, 1).Resize(, 7))
        End If
    Next
End With
With 工作表2
       .Range(.[A3], .[A3].End(xlDown).Offset(, 6)).Clear
       Rng.Copy .[A3]
End With
End Sub

TOP

回復 5# samwang samwang前輩感恩,可以運作,其他延伸功能自行測試學習,謝謝.
杜小平

TOP

隨意窩 "EXCEL迷"  blog  或https://blog.xuite.net/hcm19522/twblog
已收集8500篇 EXCEL函數

TOP

謝謝前輩發表此主題與範例
後學藉此帖練習陣列&字典
資料表:
2022-12-09_132326.JPG
2022-12-9 13:26


結果表:
2022-12-09_132333.JPG
2022-12-9 13:27


Sub TEST()
Dim Brr, C&, R&, T, V$(6), Y, N&
Set Y = CreateObject("Scripting.Dictionary")
Brr = 工作表1.UsedRange.Offset(1)
T = Split("ABC,QWE,AA,BB", ",")
For R = 1 To UBound(Brr)
   If (Brr(R, 2) = T(0) Or Brr(R, 2) = T(1)) And (Brr(R, 3) = T(2) Or Brr(R, 3) = T(3)) Then
      If Trim(Brr(R, 5)) <> "" Then
         N = N + 1
         For C = 1 To UBound(Brr, 2)
            V(C - 1) = Brr(R, C)
         Next
         Y(Brr(R, 1) & "|" & R) = V
      End If
   End If
Next
工作表2.UsedRange.Offset(3).Clear
With 工作表2.[A4].Resize(N, UBound(V))
   .Value = Application.Transpose(Application.Transpose(Y.ITEMS))
   .Sort key1:=.Item(1), Header:=xlNo
End With
Set Brr = Nothing
Set Y = Nothing
Erase T, V
End Sub
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

本帖最後由 Andy2483 於 2022-12-12 09:56 編輯

回復 2# Hsieh


    謝謝前輩
以下研習前輩心得註解,請再指導,謝謝

Option Explicit
Sub ex()
Dim A As Range, Rng As Range
'↑宣告變數
With 工作表1
'↑以下關於工作表1 程序
Set Rng = .[A1:G1]
'↑令Rng 是表一的[A1:G1]儲存格
For Each A In .Range("E:E").SpecialCells(xlCellTypeConstants)
'↑設順迴圈令A是 E欄非空格儲存格的其中一格,由前跑到後
  If (A.Offset(, -3) = "ABC" Or A.Offset(, -3) = "QWE") And (A.Offset(, -2) = "AA" Or A.Offset(, -2) = "BB") Then
  '↑如果A儲存格往左邊移3欄的儲存格值是"ABC",或儲存格值是"QWE",
  '而且A儲存格往左邊移2欄的儲存格值是"AA",或儲存格值是"BB"

     Set Rng = Union(Rng, A.Offset(, -4).Resize(, 7))
     '↑令Rng這儲存格變數是 原Rng儲存格集再添入 (A儲存格往左偏移4格開始擴展:
     '縱向不再擴展,只橫向往右擴展7欄)的儲存格範圍

  End If
Next
With 工作表2
'↑以下關於工作表2 程序
   .Range(.[A3], .[A3].End(xlDown).Offset(, 6)).Clear
   '↑工作表2 [A3]到 (從[A3]往下找到的最後一個有內容的儲存格)的儲存格集,
   '往右偏移6欄的儲存格清除

   Rng.Copy .[A3]
   '↑將Rng 儲存格集複製到 工作表2[A3]開始的範圍,
   '雖然目標儲存格集可能是間斷列,但複製於結果表會忽略空白的整列,往上遞補

   .Range(.[A3], .[A3].End(xlDown).Offset(, 6)).Sort key1:=.[A3], Header:=xlYes
   '↑工作表2 [A3]到 (從[A3]往下找到的最後一個有內容的儲存格)的儲存格集,
   '做排序!縱向,基準欄位是A欄,有標題列

End With
End With
End Sub
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

本帖最後由 Andy2483 於 2022-12-12 11:23 編輯

回復 8# Andy2483


    回復自己的粗心大意
Sub TEST()
Dim Brr, C&, R&, T, V$(6), Y, N&
'↑宣告變數(Brr,T,Y)是通用型變數,(C,R,N)是長整數,V是一維陣列V(0)~V(6)
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y是字典
Brr = 工作表1.UsedRange.Offset(1)
'↑令Brr是陣列!倒入 工作表1有使用儲存格的最小方正區域往下偏移 1列儲存格 值
T = Split("ABC,QWE,AA,BB", ",")
'↑令T是以","符號拆解雙引號內的字串一維陣列
'索引號0:"ABC" ;1:"QWE" ;2:"AA" ;3:"BB"
For R = 1 To UBound(Brr)
'↑設外順迴圈!R從1到Brr陣列縱向最大列號
   If (Brr(R, 2) = T(0) Or Brr(R, 2) = T(1)) And (Brr(R, 3) = T(2) Or Brr(R, 3) = T(3)) Then
   '↑如果(迴圈列第2欄Brr陣列值是"ABC 或 迴圈列第2欄Brr陣列值是"QWE"),
   '而且(迴圈列第3欄Brr陣列值是"AA 或 迴圈列第3欄Brr陣列值是"BB")

      If Trim(Brr(R, 5)) <> "" Then
      '↑再如果迴圈列第5欄Brr陣列值是空字元
         N = N + 1
         '↑N數字變數累加 1
         For C = 1 To UBound(Brr, 2)
         '↑設內順迴圈!C從1到 Brr陣列橫向最大欄號
            V(C - 1) = Brr(R, C)
            '↑令Brr陣列的R迴圈列C迴圈欄值帶入V一維陣列相對位置裡
         Next
         Y(Brr(R, 1) & "|" & R) = V
         '↑令以R迴圈列第1欄Brr陣列值連接 "|" 符號,再連接R迴圈數 為key,
         'item是V一維陣列

      End If
   End If
Next
工作表2.UsedRange.Offset(3).Clear
'↑令 工作表2有使用儲存格的最小方正區域往下偏移 3列儲存格清除
With 工作表2.[A4].Resize(N, UBound(V) + 1)
'↑再次複習才檢查到欄數應該要加 1,因為UBound(V)指的不是陣列最大元素數!是最大索引號
'以下有關於 工作表2.[A4]向下擴展N列,向右擴展V一維陣列最大索引號數+1 的範圍儲存格
   .Value = Application.Transpose(Application.Transpose(Y.ITEMS))
   '↑擴展範圍儲存格的值以Y字典的item轉置後倒入
   .Sort key1:=.Item(1), Header:=xlNo
   '做排序!縱向,基準欄位是擴展區域的第 1欄,沒有標題列
End With
Set Brr = Nothing
Set Y = Nothing
Erase T, V
'↑釋放變數
End Sub

資料表:
2022-12-12_111256.JPG
2022-12-12 11:14


With 工作表2.[A4].Resize(N, UBound(V))
2022-12-12_111319.JPG
2022-12-12 11:14


With 工作表2.[A4].Resize(N, UBound(V) + 1)
2022-12-12_111334.JPG
2022-12-12 11:15
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

        靜思自在 : 心中常存善解、包容、感思、知足、惜福。
返回列表 上一主題