如何加資料 - Excel程式區 - 麻辣家族討論版版

帖子: 135
主題: 19
精華: 0
積分: 165
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 香港
註冊時間: 2010-12-9
最後登錄: 2012-8-27

12^#

發表於 2011-1-4 20:38 | 只看該作者

我做了一個完整的程式,樓主可以試試,大家也可給意見
寫得真慢,40幾行花了一天時間

80 字節以內
不支持自定義 Discuz! 代碼

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 267
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-31

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

13^#

發表於 2011-1-4 21:53 | 只看該作者

回復 10# FAlonso

Sub Ex()
On Error Resume Next
Dim Mystr(), MyCnt()
i = 1
Do Until Cells(i, 1) = ""
If IsError(Application.Match(Cells(i, 1) & "," & Cells(i, 2) & "," & Cells(i, 3) & "," & Cells(i, 4), Mystr, 0)) Then
ReDim Preserve Mystr(s)
ReDim Preserve MyCnt(s)
Mystr(s) = Cells(i, 1) & "," & Cells(i, 2) & "," & Cells(i, 3) & "," & Cells(i, 4)
MyCnt(s) = Cells(i, 5)
s = s + 1
Else
k = Application.Match(Cells(i, 1) & "," & Cells(i, 2) & "," & Cells(i, 3) & "," & Cells(i, 4), Mystr, 0)
MyCnt(k) = MyCnt(k - 1) + Cells(i, 5)
End If
i = i + 1
Loop
For i = 0 To s - 1
Cells(i + 1, 8).Resize(, 4) = Split(Mystr(i), ",")
Cells(i + 1, 12) = MyCnt(i)
Next
End Sub

複製代碼

學海無涯_不恥下問

basarasy

帖子: 287
主題: 65
精華: 0
積分: 357
點名: 0
作業系統: xp
軟體版本: OFFIC 2007
閱讀權限: 20
註冊時間: 2010-6-4
最後登錄: 2015-8-19

14^#

發表於 2011-1-4 22:19 | 只看該作者

還有1個小問題想請教Hsieh大大的.
可否用 Range(cells(,),cells(,)) 同時Select 2個or多個地方?
Range(cells(a,b),cells(c,d)) + Range(cells(e,f),cells(g,h))

50 字節以內
不支持自定義 Discuz! 代碼

linshin1999

帖子: 199
主題: 45
精華: 0
積分: 252
點名: 0
作業系統: windows 7 (X64)
軟體版本: office 2010 (x64)
閱讀權限: 20
性別: 男
來自: 桃園
註冊時間: 2010-12-24
最後登錄: 2020-3-31

論壇贊助勳章論壇榮譽勳章

15^#

發表於 2011-1-4 22:23 | 只看該作者

在VBE模式下有一個?號,就是在寫VBA有問是題時可以點一下問號,然後把不懂的打進去搜尋,通長都會得到答案.
如下就是 Scripting.Dictionary 搜尋出來的結果,

Dictionary 物件與 PERL 相關陣列一樣。可以存放任何型式的資料項目陣列。每個項目都是唯一的關鍵字。該關鍵字用來取出單個項目，通常是整數或字串，可以是存放除陣列以外的任何型別資料。

下面舉例說明了如何建立一個 Dictionary 物件：

Dim d '建立一個變數
Set d = CreateObject(Scripting.Dictionary)
d.Add "a", "Athens" '加入一些關鍵字和項目
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
...

因為說明檔是直接翻譯的所以文句很不順,以上文字有經過修改,但是目前說明檔仍然是學習Excel最簡便的工具,大家做參考.

V98

basarasy

帖子: 287
主題: 65
精華: 0
積分: 357
點名: 0
作業系統: xp
軟體版本: OFFIC 2007
閱讀權限: 20
註冊時間: 2010-6-4
最後登錄: 2015-8-19

16^#

發表於 2011-1-4 22:27 | 只看該作者

回復 15# linshin1999

變數要用Object嗎?
Dim d as Object ??

50 字節以內
不支持自定義 Discuz! 代碼

帖子: 135
主題: 19
精華: 0
積分: 165
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 香港
註冊時間: 2010-12-9
最後登錄: 2012-8-27

17^#

發表於 2011-1-4 22:35 | 只看該作者

回復 basarasy
這是很直觀的代碼
Hsieh 發表於 2011-1-3 22:50

兩次使用application.transpose有點難解,數學上應該沒轉變,所謂的"標準二維陣列"是什麼

80 字節以內
不支持自定義 Discuz! 代碼

帖子: 135
主題: 19
精華: 0
積分: 165
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 香港
註冊時間: 2010-12-9
最後登錄: 2012-8-27

18^#

發表於 2011-1-7 13:26 | 只看該作者

本帖最後由 FAlonso 於 2011-1-8 20:25 編輯

關於transpose問題....

例如excel有如下排列
A B C D
1  r
2  e
3  s
4  t

將一個column的字連串:
transpose一次

結果是r,e,s,t

Sub abc()
Dim mystring
mystring = Join(Application.Transpose(Range("A1:a4").Value), ",") '注意這裡是一個column串
Range("A10").Value = mystring
End Sub

複製代碼

將一個row的字連串:
transpose二次

A B C D
1 r t u i

Sub abc()
Dim mystring
mystring = Join(Application.Transpose(Application.Transpose(Range("A1:D1"))), ",") '注意這裡是一個row串
Range("A10").Value = mystring
End Sub

複製代碼

結果是r,t,u,i

今日做了一點詳細研究,是土法大鍊鋼
先把以下程式抄進VBA

Sub check()
Dim ar As Variant
Dim i As Integer
Set ar = [a1:a4] 'try [a1:d1] later
For i = 1 To 6
ar = Application.Transpose(ar)
Next
Set ar = Nothing
End Sub

複製代碼

打開檢視->區域變數視窗,再按F8,逐行執行,觀察ar陣的資料

先看[a1:a4],一個column的range
是一個2D陣列(看紅色圈子), variant(1 to 4,1 to 1)

transpose一次後,變成了一個1D陣列, variant(1 to 4),這個是可以進入join()程式的東東

不論再如何transpose,都只會重覆variant(1 to 4,1 to 1) -> variant(1 to 4) -> variant(1 to 4,1 to 1) 這個循環

再看[a1:d1](自己把程式修改),一個row的range
是一個2D陣列, variant(1 to 1,1 to 4),這裡不再print screen了,大家自己看看
transpose一次後,變成另外一個2D陣列,叫variant(1 to 4,1 to 1),這樣是不能進入join程式
transpose第二次,便變了variant(1 to 4),可以了!
但之後無論怎transpose,都只會重覆variant(1 to 4,1 to 1) -> variant(1 to 4) -> variant(1 to 4,1 to 1) 這個循環,永遠不會變回variant(1 to 1,1 to 4)這個設定

打個比喻,就等如一個2-D row的陣列,首先變了"類似"2-D column的形態,再變1-D array
而2-D column就馬上變了1-D array
這樣應該能夠解釋為什麼row要transpose多一次,但row為什麼要首先變成column形,不要問我

最後d1.items那行
看以下例子

Dim myrange As Range
Dim i As Integer, k
Set myobject = CreateObject("scripting.dictionary")
myobject("A") = Array(1, 2)
myobject("B") = Array(4, 5)
myobject("C") = Array(7, 8)
Set myrange = Worksheets("sheet2").Range("A1").Resize(3, 2)
k = myobject.items
k = Application.Transpose(Application.Transpose(k))
myrange = k

複製代碼

在完成myobject配置後,區域變數的顯示指該物件尚未是array(沒有那些variant(x,y),純粹是很散的架構)
把myobject.items叫出來,便看到k有variant(0,2)的1D形態(3個索引,"A","B","C")
打開k的"+"鍵,會看到k(0),k(1),k(2)各自都有variant(0,1)的1D形態(即每個索引中的兩個數字的表示)
transpose()一次,便會成一個variant(1 to 2,1 to 3)的2D陣列
其實此時已經可以貼上格子囉!試把resize(3,2)變成(2,3)看看!
不過因為我們想排成
   A    B
1 1    2
2 4    5
3 7       8
所以再transpose一次而已

80 字節以內
不支持自定義 Discuz! 代碼

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 267
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-31

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

19^#

發表於 2011-1-7 16:06 | 只看該作者

回復 18# FAlonso
儲存格指定出來的範圍
不論是1列或多列
excel均將視為二維陣列
經過transpose函數轉置後才會得到正確的維數
所以當你的原陣列是以一維陣列儲存多個陣列成為多維陣列時
如
Dim Ay()
For i = 0 To 10
ReDim Preserve Ay(i)
Ay(i) = Array(i * 1, i * 2, i * 3, i * 4, i * 5)
Next
[A1].Resize(i, 5) = Application.Transpose(Application.Transpose(Ay))
Ay陣列元素是陣列
要以一次寫入就必須使用2次transpose

學海無涯_不恥下問

帖子: 135
主題: 19
精華: 0
積分: 165
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 香港
註冊時間: 2010-12-9
最後登錄: 2012-8-27

20^#

發表於 2011-1-7 18:12 | 只看該作者

回復 19# Hsieh
那麼正確的維數其實是怎樣定義? 想來想去都想不通
在我的示範,Range("A1:A4")算不算是一個陣列?
為什麼打直的格子,一次transpose就可以,打橫的要兩次? 我試過打直的用兩次transpose,會有錯誤出現

還有

d(mystr) = d(mystr) + A.Offset(, 4).Value

複製代碼

這句是怎解釋,為什麼可以作累加的作用
是否dictionary自動就是array,不需declare(即像普通的變數要作x()這樣的宣告))?

希望H大解答

80 字節以內
不支持自定義 Discuz! 代碼