money-4

[myleoyes]

oobird前輩你好!
　　　前輩不好意思小弟將你好好的程式
　　　Sub yy()
　　　Dim rng, arr, d As Object, i%, k, m
　　　[e2:g1000] = ""
　　　rng = Range([a2], "c" & [a65536].End(xlUp).Row)
　　　Set d = CreateObject("Scripting.Dictionary")
　　　For i = UBound(rng) To 1 Step -1
　　　If rng(i, 3) <> "" Then
　　　If d(rng(i, 2)) = "" Then
　　　d(rng(i, 2)) = rng(i, 1) & "," & rng(i, 3)
　　　End If
　　　End If
　　　Next i
　　　k = d.keys: m = d.items
　　　ReDim arr(1 To d.Count, 1 To 3)
　　　For i = 1 To d.Count
　　　arr(i, 1) = Split(m(i - 1), ",")(0): arr(i, 2) = k(i - 1): arr(i, 3) = Split(m(i - 1), ",")(1)
　　　Next i
　　　[e2].Resize(i - 1, 3) = arr
　　　End Sub
　　　改得狼狽不堪,又無法達成目標,敬請賜教以便達成夢想謝謝再三!!
　　　

[oobird]

没看出来你的目的。最好范例文件上标上完成后的结果，便于理解！

[myleoyes]

oobird前輩你好!
　　　謝謝你!H,I欄應該是顯示數量與金額的值而非項目資料      
　　　再附檔案中,在H,I欄與歷史訊息工作表中第三次資料就是要完成的目標   
　　　前輩請別忘了檔案的主導權是落在C欄喔!            
　　　不好意思再辛苦你費心囉!敬請賜教謝謝再三!!

[oobird]

對不起，看了半天還是猜不到你的目的。是把歷史訊息匯總到分析的a:e還是分析到f:j？
a:e與f:j要產生什麼關係？

[myleoyes]

oobird前輩你好!
　　　謝謝你!不好意思辛苦你,是這樣子當在C欄任一儲存格內輸入所須要的數量
　　　按下小計鈕就會在F:J欄產生所要的資料,如附檔F2:F7的日期皆為97/5/12
　　　而G2:G7分別為F~A,H2:H7分別為5~5,I2:I7分別為6~1,J2:J7分別為30~5等等,
　　　程式同時將F2:J7之資料複製至歷史訊息工作表中儲存以便建立歷史資料備查
　　　此時K,L欄也自動產生這次資料的日期與合計之訊息,簡單的說
　　　就是將分析工作表中的F:J匯總到歷史訊息工作表中的A:E,這樣解釋前輩是否明白呢?
　　　尚請費心謝謝再三!!

[oobird]

整理一下：
是否把a:e的資料反序排在f:j，再把f:j複製到歷史訊息？而F:J要有格線，其他的不要？

[myleoyes]

oobird前輩你好!
　　　謝謝你!不須要將a:e的資料反序排在f:j,且直接將f:j複製到歷史訊息即可
　　　F:J是要有格線,也就是說當C欄有輸入多少個儲存格,F:J就有多少列格線,
　　　然而歷史訊息的資料是沒有格線的,不好意思再辛苦前輩囉!謝謝再三!!

[hsieh]

Try it !

[myleoyes]

hsieh前輩你好!
　　　 謝謝你!程式是可以但是有點須要修改,就是增加F,J欄在執行下筆資料時有清除
　　　上次的資料且向上靠攏的功能,如附檔案說明不好意思再辛苦前輩囉!謝謝再三!!

[oobird]

Sub keepdata()
Dim r&, Arr As Range
With Sheets("分析")
.[F2:J1000].Clear
r = .[C65536].End(xlUp).Row
Set Arr = .[A1].Resize(r, 5)
c = 1
For i = 2 To r
If Len(Arr(i, 3)) > 0 Then
c = c + 1
Cells(c, 6) = Format(Arr(i, 1), "[$-404]e/m/d;@")
Cells(c, 7).Resize(1, 4) = Arr(i, 2).Resize(1, 4).Value
End If
Next
If Application.CountIf(.Columns("K"), Date) = 0 Then
Sheets("歷史訊息").[A65536].End(xlUp).Offset(1, 0).Resize(c - 1, 5) = [f2].Resize(c - 1, 5).Value
[f2].Resize(c - 1, 5).Borders.LineStyle = xlContinuous
.[K1] = Application.Sum(.Columns("J"))
.[K65536].End(xlUp).Offset(1, 0).Resize(, 2) = Array(Format(Date, "[$-404]e/m/d;@"), .[K1])
End If
End With
End Sub