t_t7225

回復 10# lpk187

總算了解意思了
謝謝大大精闢的解說
又釐清了更多的觀念了

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列,學習方案如下,請各位前輩指教
執行前:

下載 (94.44 KB)

2023-12-4 07:53

執行結果:

下載 (109.55 KB)

2023-12-4 07:53

Option Explicit
Sub TEST()
Dim Brr, Crr, i&, j%, R&, T$
'↑宣告變數
Brr = Intersect(ActiveSheet.UsedRange, [A:K])
'↑令Brr變數是 裝盛指定儲存格值的二維陣列
ReDim Crr(1 To 1000, 1 To 4)
'↑宣告Crr變數是二維 空陣列
For i = 3 To UBound(Brr)
'↑設順迴圈!i從3到Brr陣列縱向最大索引列號
   If T <> Trim(Brr(i, 1)) And Trim(Brr(i, 1)) <> "" Then T = Trim(Brr(i, 1))
   '↑如果T變數與 i迴圈列第1欄Brr陣列值(且不是空值)不同??就令T是該值
   If Val(Brr(i, 10)) = 0 Then GoTo i01 Else R = R + 1: Crr(R, 1) = T
   '↑如果i迴圈列第10欄Brr陣列值轉乘的數值是0?? 就跳到標示 i01位置繼續執行,
   '否則就令R變數累加1,令R變數列第1欄Crr陣列值是 T變數
   For j = 3 To 9
   '↑設順迴圈!j從3到9
      If Trim(Brr(i, j)) <> "" Then
      '↑如果逐欄判定其值不是空值
         Crr(R, 2) = Brr(2, j)
         '↑令第2欄Crr陣列值以Brr陣列第2列第j迴圈欄值帶入
         Crr(R, 3) = Brr(i, j)
         '↑令第3欄Crr陣列值以Brr陣列第i迴圈列第j迴圈欄值帶入
         Crr(R, 4) = Brr(i, 10)
         '↑令第4欄Crr陣列值以Brr陣列第i迴圈列第10欄值帶入
         Exit For
         '↑令跳出j變數的迴圈
      End If
   Next
i01: Next
[R:U].ClearContents
'↑令結果欄內容清除
If R = 0 Then Exit Sub
'↑如果R變數是 0(代表沒有符合的資料),就結束程式執行
[R3].Resize(R, 4) = Crr
'↑令指定儲存格擴展剛好的範圍儲存格值以Crr陣列值帶入
End Sub

hcm19522

(輸入編號12096) google網址:https://hcm19522.blogspot.com/

singo1232001

Sub t5()
I = Split("Provider=Microsoft.,Jet.OLEDB.4,.0;Extended Properties=Excel ,8,.0;Data Source=", ",")
If Application.Version > 12 Then I(1) = "ACE.OLEDB.12": I(3) = 12
Set cn = CreateObject("adodb.connection"): cn.Open Join(I, "") & ThisWorkbook.FullName
q = "select F1,left(B,1),B,I from( select F1,F3&F4&F5&F6&F7&F8&F9 "
q = q & "as B,I FROM [" & ActiveSheet.Name & "$A1:K] where I is not NULL)"
[S:V].ClearContents: [s3].CopyFromRecordset cn.Execute(q)
For Each Z In [s3].CurrentRegion
If Z.Value = "" Then Z.Value = Z.Offset(-1, 0)
Next
End Sub