Jared

回復 8# GBKEE

想請問一下大大有關您協助程式碼的問題
以下的程式是用什麼原理去寫的呢?
有點不太清楚
如果範圍不是A1:C10
而是A1:D10 或是其他範圍
要修改哪個地方呢?
希望大大能幫我解答，感激不盡><

    ReDim A(1 To UBound(Ar(1), 1), 1 To UBound(Ar(1), 2))
    For X = 1 To UBound(Ar(1), 2)
        For i = 1 To UBound(Ar(1), 2)
            For ii = 1 To UBound(Ar(1), 1)
                If ii = 1 Then
                    A(ii, i) = Ar(X)(ii, i)
                Else
                    A(ii, i) = IIf(A(ii, i) <> "" And Ar(X)(ii, i) <> "", "資料有誤", A(ii, i) & Ar(X)(ii, i))
                End If
            Next
        Next
    Next
    Workbooks("總表彙整.xls").Sheets(1).Range(Rng) = A
End Sub

Jared

回復 4# GBKEE

請問大大，現在有一個表單
需要統計三個人安排旅遊的時間和地點
有套用你的ＶＢＡ程式
但是有地方不曉得該怎麼修改

程式執行的流程如下：
旅遊地點先驗證是否有誤，怕有人修改到　
分別有四個時間點要統計
最後在意見彙整的部分顯示統計合時何地最高票

麻煩大大了，目前為了怎麼修改傷透腦筋＞\\＜
工作總表.zip (31.61 KB)

下載次數: 10

2013-8-2 14:50

GBKEE

回復 12# Jared

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As String, Ar(1 To 3), A(), i As Integer, ii As Integer, X As Integer
   
4.     '要合併 三個檔案.  -> Ar(1 To 3)
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     A = Array("D:\工作總表\小明.xls", "D:\工作總表\小華.xls", "D:\工作總表\小美.xls")   '路徑及檔名請依需求修改
   
8.     Rng = "A1:E10"                    '定所有檔案在相同的範圍
   
9.     For i = 0 To UBound(A)
   
10.         With Workbooks.Open(A(i)).Sheets(1)                    'With 陳述式 在一個單一物件或一個使用者自訂型態上執行一系列的陳述式。
    
11.             Ar(i + 1) = .Range(Rng).Value                         '二維陣列:第一維 = 工作表的列,第二維 = 工作表的欗,
    
12.             .Parent.Close
    
13.         End With
    
14.     Next
    
15.     ReDim A(1 To UBound(Ar(1), 1), 1 To UBound(Ar(1), 2))   '陣列 重新配置 維數及維數元素之上下限索引值-> "A1:E10" 的大小
    
16.     For X = 1 To UBound(Ar)
    
17.         For i = 1 To UBound(Ar(1), 2)                       '欄
    
18.             For ii = 1 To UBound(Ar(1), 1)                  '列
    
19.                 If ii = 1 Or i = 1 Then
    
20.                     A(ii, i) = Ar(X)(ii, i)                 '第1列 或 第1欗
    
21.                 Else
    
22.                     If Ar(X)(ii, i) <> "" Then A(ii, i) = A(ii, i) + 1  '有資料 + 1
    
23.                 End If
    
24.             Next
    
25.         Next
    
26.     Next
    
27.     Workbooks("旅遊地點統計.xls").Sheets(1).Range(Rng) = A
    
28.     Application.ScreenUpdating = True '結束後更新螢幕
    
29.     Application.DisplayAlerts = True
    
30. End Sub

複製代碼

Jared

回復 13# GBKEE


感謝大大的協助
陣列索引的使用方式還需要研究研究
先試著修改看看

再次謝謝大大^^