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)

收藏 分享

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 2015-7-21 17:43 | 只看該作者
回復 1# b31978


    試試看，也不知對不對！
  1. Public Sub test()
  2. Dim arr()
  3. aa = Cells(Rows.Count, 10).End(xlUp).Row
  4. xx = WorksheetFunction.CountA(Range("J3:J" & aa))
  5. i = 1
  6. ReDim arr(1 To xx, 1 To 4)
  7. For Each Rng In Range("C3:i" & aa)
  8.     If Rng <> "" Then
  9.         ss = Cells(Rng.Row, 1).MergeArea
  10.         arr(i, 1) = ss(1, 1)
  11.         arr(i, 2) = Cells(2, Rng.Column)
  12.         arr(i, 3) = Rng
  13.         arr(i, 4) = Cells(Rng.Row, 10)
  14.         i = i + 1
  15.     End If
  16. Next
  17. Range("M3").Resize(xx, 4) = arr
  18. End Sub
複製代碼

TOP

b31978

帖子
14 
主題
5 
精華
0 
積分
19 
點名
0  
作業系統
xp 
軟體版本
2003 
閱讀權限
10 
性別
男 
註冊時間
2011-9-5 
最後登錄
2015-7-22 
3#
發表於 2015-7-22 07:54 | 只看該作者
回復 2# lpk187

感謝，想了很久，一直沒有有效的思路，謝謝大大~ 感恩:D

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2015-7-22 14:01 | 只看該作者
回復 3# b31978
試試看
  1. '一般模組程式碼
  2. Option Explicit
  3. Sub Ex()
  4.     Dim Rng As Range, C As Range, S, Ar(), At(), i As Integer
  5.     Set Rng = ActiveSheet.Range("A3")
  6.     Do While Rng <> ""
  7.         With Rng.Offset(, 2).Resize(Rng.MergeArea.Count, 7)
  8.         'Rng.MergeArea 儲存格的合併範圍
  9.         'Rng.MergeArea.Count 合併範圍的Cells總計
  10.             If Application.CountA(.Cells) > 0 Then '.Cells :這 With 物件範圍Range的Cells
  11.                 '工作表函數 CountA 計算範圍內有資料的Cells個數
  12.                 For Each C In .SpecialCells(xlCellTypeConstants)
  13.                     'SpecialCells 特殊儲存格 (xlCellTypeConstants :字串,數字 )
  14.                     ReDim Ar(1 To 4)      '重置陣列
  15.                     Ar(1) = Rng.Value
  16.                     Ar(2) = Cells(2, C.Column)
  17.                     Ar(3) = C
  18.                     Ar(4) = Cells(C.Row, "j")
  19.                     i = i + 1
  20.                     ReDim Preserve At(1 To i)  '重置陣列:Preserve保留原有的元素
  21.                     At(i) = Ar
  22.                 Next
  23.             End If
  24.         End With
  25.         Set Rng = Rng.End(xlDown) '下一個有合併範圍的Range
  26.     Loop
  27.     If i > 0 Then [M3].Resize(i, 4) = Application.Transpose(Application.Transpose(At))
  28. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

b31978

帖子
14 
主題
5 
精華
0 
積分
19 
點名
0  
作業系統
xp 
軟體版本
2003 
閱讀權限
10 
性別
男 
註冊時間
2011-9-5 
最後登錄
2015-7-22 
5#
發表於 2015-7-22 18:04 | 只看該作者
回復 4# GBKEE

謝謝 各位大大的協助，幫了大忙了，謝謝~

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

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

lpk187

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

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 
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-2-26 

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

        靜思自在 : 盡多少本份，就得多少本事。
12
返回列表 上一主題