麻辣家族討論版版 » Excel程式區 » 請問如何將陣列資料做整理在查找檔顯示出來?

返回列表下一主題上一主題發帖

請問如何將陣列資料做整理在查找檔顯示出來?

中學生 Rank: 2

帖子: 40
主題: 10
精華: 0
積分: 83
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
註冊時間: 2011-6-3
最後登錄: 2020-10-1

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2011-8-12 19:38 | 只看該作者

請問如何將陣列資料做整理在查找檔顯示出來?

如有上千個檔案它的檔名是A001.XLS....,請問我打開查尋檔案在A1欄位輸入A001按指令按鈕
就可以從A3位置顯示像這樣的格式請問VBA要如何寫?謝謝你

TEST1.rar (5.52 KB)

樓主熱帖

收藏

中學生 Rank: 2

帖子: 40
主題: 10
精華: 0
積分: 83
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
註冊時間: 2011-6-3
最後登錄: 2020-10-1

8^#

發表於 2011-8-13 15:36 | 只看該作者

謝謝超級版主又多學了一點...

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

7^#

發表於 2011-8-13 14:46 | 只看該作者

Workbooks.Open Filename:=ThisWorkbook.Path & "\" & [a1] & ".xls"
With ActiveSheet
n = .[a65536].End(xlUp).Row
arr = .Range(.[a1], .Cells(n, 5))
執行到這一句時，已把所有數據存在陣列記憶中了，之後的存取都在這個陣列中
打開的活頁簿已經用不著就可以關閉了。
你要移到後面再關也隨你了。不可能移到後面去程式才會ok的。

中學生 Rank: 2

帖子: 40
主題: 10
精華: 0
積分: 83
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
註冊時間: 2011-6-3
最後登錄: 2020-10-1

6^#

發表於 2011-8-13 12:37 | 只看該作者

超級版主對不起啦!我在試時來源檔close時後面的資料沒顯示出來,所以就把ActiveWorkbook.Close True移到後面就ok了,讓我很疑問為什麼來源檔close
資料是存在哪做處理?所以超級版主那有可能寫錯,是我太菜啦!不見怪..

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

5^#

發表於 2011-8-13 10:41 | 只看該作者

本帖最後由 oobird 於 2011-8-13 10:52 編輯

喔，讓我有點疑惑,因為超級版主
寫的那會有問題,沒關係，哈哈！在下想請教，是哪裡會有問題？
說出來也好讓我學習學習。

中學生 Rank: 2

帖子: 40
主題: 10
精華: 0
積分: 83
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
註冊時間: 2011-6-3
最後登錄: 2020-10-1

4^#

發表於 2011-8-13 07:27 | 只看該作者

謝謝超級版主我知道如何做了,來源檔是否太早關了!讓我有點疑惑,因為超級版主
寫的那會有問題,沒關係我會去了解的,謝謝你的指導....

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

3^#

發表於 2011-8-12 21:45 | 只看該作者

Sub yy()
Dim n%, i%, j%, m%, arr, arr2(), b()
ActiveSheet.UsedRange.Offset(2, 0) = ""
Application.ScreenUpdating = False
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & [a1] & ".xls"
With ActiveSheet
n = .[a65536].End(xlUp).Row
arr = .Range(.[a1], .Cells(n, 5))
ReDim arr2(1 To 5, 1 To UBound(arr))
End With
ActiveWorkbook.Close True
Set d = CreateObject("scripting.dictionary")
For i = 1 To n
If i = 1 Then x = "總計" Else x = arr(i, 4) - arr(i, 5)
b = Array(arr(i, 1), arr(i, 2), arr(i, 4), arr(i, 5), x)
If Not d.exists(arr(i, 1)) Then
m = m + 1
d(arr(i, 1)) = m
For j = 1 To 5
arr2(j, m) = b(j - 1)
Next
Else
For j = 3 To 5
arr2(j, d(arr(i, 1))) = arr2(j, d(arr(i, 1))) + arr(i, j)
Next
End If
Next
[a3].Resize(m, 5) = Application.Transpose(arr2)
Application.ScreenUpdating = True
End Sub

複製代碼

中學生 Rank: 2

帖子: 40
主題: 10
精華: 0
積分: 83
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
註冊時間: 2011-6-3
最後登錄: 2020-10-1

2^#

發表於 2011-8-12 21:00 | 只看該作者

我好象發錯區了!

靜思自在 : 一句溫暖的話，就像往別人身上灑香水，自己會沾到兩三滴。

返回列表下一主題上一主題