12
返回列表 上一主題 發帖

[發問] 不規則資料，如何重整.....

b31978

帖子
14 
主題
5 
精華
0 
積分
19 
點名
0  
作業系統
xp 
軟體版本
2003 
閱讀權限
10 
性別
男 
註冊時間
2011-9-5 
最後登錄
2015-7-22 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2015-7-21 16:48 | 只看該作者

[發問] 不規則資料，如何重整.....

VBA
請教各位先進:

如何用vba程式，將資料重整為右側的格式
困難點在於:每日最多5筆，最少為0筆，每筆位置不一致~

尚請不吝提供想法，謝謝~

Snap9.jpg (63.09 KB)

Snap9.jpg

不規則.zip (11.65 KB)

收藏 分享

singo1232001
　暱稱: 熱狗慶

中學生Rank: 2

帖子
354 
主題
5 
精華
0 
積分
387 
點名
0  
作業系統
windows7 
軟體版本
vba,vb,excel2007 
閱讀權限
20 
性別
男 
註冊時間
2017-1-8 
最後登錄
2024-8-2 

論壇榮譽勳章論壇贊助勳章
14#
發表於 2023-12-8 09:30 | 只看該作者
本帖最後由 singo1232001 於 2023-12-8 09:35 編輯

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

TOP

hcm19522

帖子
1387 
主題
4 
精華
0 
積分
1397 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2015-9-11 
最後登錄
2024-11-24 

熱烈參與勳章
13#
發表於 2023-12-4 16:47 | 只看該作者
(輸入編號12096) google網址:https://hcm19522.blogspot.com/
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
12#
發表於 2023-12-4 07:55 | 只看該作者
本帖最後由 Andy2483 於 2023-12-4 08:54 編輯

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


執行結果:



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

TOP

t_t7225

帖子
6 
主題
1 
精華
0 
積分
21 
點名
0  
作業系統
XP 
軟體版本
32 
閱讀權限
10 
註冊時間
2015-7-8 
最後登錄
2017-7-21 
11#
發表於 2015-7-24 08:49 | 只看該作者
回復 10# lpk187

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

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
10#
發表於 2015-7-23 22:12 | 只看該作者
本帖最後由 lpk187 於 2015-7-23 22:15 編輯

回復 9# t_t7225


    SS只是一個變數，是一個沒有定格子的陣列，每次執行時並不相同
不像arr(1 to 3)這種，而是會像下面例子一樣
把下面代碼執行看看再看區域變數視窗就了解了
Public Sub ex1()
'第一次執行ar
ar = Array("1", "2", "3", "4")
'ar為ar(0)="1",ar(1)= "2" ,ar(2) = "3",ar(3) = "4"
'第二次執行ar
ar = Array("1", "2")
'ar為ar(0)="1",ar(1)= "2"
End Sub
以原來的代碼是跑迴圈的所以執行起來就有點類似上面例子的樣子

TOP

t_t7225

帖子
6 
主題
1 
精華
0 
積分
21 
點名
0  
作業系統
XP 
軟體版本
32 
閱讀權限
10 
註冊時間
2015-7-8 
最後登錄
2017-7-21 
9#
發表於 2015-7-23 21:51 | 只看該作者
回復 8# lpk187


感謝lpk187大大的回覆
知道arr（i,1）=ss
那我就瞭解這段程式碼的意思了

但是唯一還是不解的地方是
ss我當時也是揣測為陣列

但是不明白的地方是ss（1，1）
如果ss為陣列其陣列值應為ss（day1,day2,day3）
那ss（1,1）不是應該固定為‘’day1‘’
ss（2,1）=”day2”這樣才對嗎？
還是這部分我有認知錯誤呢？

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
8#
發表於 2015-7-23 20:36 | 只看該作者
本帖最後由 lpk187 於 2015-7-23 20:42 編輯

回復 7# t_t7225


    ss = Cells(Rng.Row, 1).MergeArea
        arr(i, 1) = ss(1, 1)
這一段正確是寫成
arr(i, 1) =Cells(Rng.Row, 1).MergeArea(1)
.MergeArea為合併儲存格的Value
既然是合併儲存格也就是多個儲存格組成的一個陣列其陣列一般都只有第一格有其Value
ss = Cells(Rng.Row, 1).MergeArea那ss也是MergeArea的陣列，只是方便在區域變數視窗中觀察MergeArea陣列的維數及內容，無其他意義！
ss會變化其實是MergeArea的陣列在變化

TOP

t_t7225

帖子
6 
主題
1 
精華
0 
積分
21 
點名
0  
作業系統
XP 
軟體版本
32 
閱讀權限
10 
註冊時間
2015-7-8 
最後登錄
2017-7-21 
7#
發表於 2015-7-23 17:42 | 只看該作者
回復 6# t_t7225

另外還想問一下 為什麼arr(i,1)=ss(1,1)
ss(1,1)維持不變卻可以有day1,day2,day3的變化
真的百思不得其解
還麻煩大大解惑

抱歉超過3分鐘來不及編輯...

TOP

t_t7225

帖子
6 
主題
1 
精華
0 
積分
21 
點名
0  
作業系統
XP 
軟體版本
32 
閱讀權限
10 
註冊時間
2015-7-8 
最後登錄
2017-7-21 
6#
發表於 2015-7-23 17:34 | 只看該作者
本帖最後由 t_t7225 於 2015-7-23 17:36 編輯
For Each Rng In Range("C3:i" & aa)
    If Rng <> "" Then
        ss = Cells(Rng.Row, 1).MergeArea
        arr(i, 1) = ss(1, 1)
        arr(i, 2) = Cells(2, Rng.Column)
        arr(i, 3) = Rng
        arr(i, 4) = Cells(Rng.Row, 10)
        i = i + 1
    End If
Next


想請問b31978大大
ss = Cells(Rng.Row, 1).MergeArea
        arr(i, 1) = ss(1, 1)
這段程式碼ss的意思是什麼?
為什麼可以上面那句ss 下面那句卻可以變成ss(x,y)型式
可否幫小弟解惑一下

不好意思,在問題中衍伸問題
但真的很想知道...

TOP

        靜思自在 : 【時間無法遮擋】怕時間消逝，花了許多心血，想盡各式方法要遮擋時間，結果是：浪費了更多時間，且一無所成！
12
返回列表 上一主題