請問如何在資料檔各工作表做整理在查詢檔顯示出來?

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

2^#

發表於 2011-8-22 15:16 | 顯示全部帖子

sFName = "C:\資料庫\" & tdate & "月\" & stcok & "" & fdate & ".xls" ' 指定查找檔案路徑目錄"
            Workbooks.Open Filename:=sFName, ReadOnly:=True ' 開檔
            p = Sheets.Count
            Do
            With Sheets(p)
                  n = .[A65536].End(xlUp).Row
                  arr = .Range(.[A1], .Cells(n, 6))
               ReDim arr2(1 To 5, 1 To UBound(arr)) '在程序層次中用來重新配置動態陣列變數的儲存空間
                     Set d = CreateObject("scripting.dictionary")

                        For i = 2 To n
                     chk = Mid(arr(i, 1), 1, 3)
                        If stcode = chk Then
                        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))) + b(j - 1)
                           Next
                        End If
                        Else
                        End If
                        Next

            End With
            On Error Resume Next
            irow = wbook.[A65536].End(xlUp).Row
         wbook.Range("A" & irow + 1).Resize(M, 5) = Application.Transpose(arr2)
            p = p - 1: M = 0
            Loop While p > 0

         Application.DisplayAlerts = False
         ActiveWorkbook.Close SaveChanges:=False
         Sheets("Web").Activate
                  n = [A65536].End(xlUp).Row
                  arr = Range([A2], Cells(n, 6))
               ReDim arr2(1 To 5, 1 To UBound(arr))                         Set d = CreateObject("scripting.dictionary")
                           For i = 2 To n
               b = Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5))

                        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))) + b(j - 1)
                           Next
                        End If

                        Next
               Range("g1").Resize(M, 5) = Application.Transpose(arr2)
目前必須把各工作表處理完的資料放到sheet("web")的工作表,再處理一次
請問如何處理一次就好,對於陣列資料真的很頭痛,感謝大大能幫我解惑!謝謝善心人士.

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

3^#

發表於 2011-8-22 19:12 | 顯示全部帖子

謝謝GBKEE大大我附上A檔與B08檔,感謝你的幫忙..

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

4^#

發表於 2011-8-27 09:16 | 顯示全部帖子

好心的大大可以簡化嗎?不然提示一下也可以!雖然可以達到要求但總覺得怪怪的....

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

5^#

發表於 2011-8-27 14:35 | 顯示全部帖子

本帖最後由 flask 於 2011-8-27 15:04 編輯

回復 6# Hsieh

謝謝Hsieh 超級版主真的簡潔好多,但是各工作頁沒做加總.

應該是像這樣

,
真的感謝你的幫忙,還有用廠商代碼做判別是因為廠商名稱有的會空白,這個
沒關係我知道如何用,謝謝你...

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

6^#

發表於 2011-8-31 08:27 | 顯示全部帖子

請教好心的大大,我用這樣的方式處理有一個問題;
當廠商代碼有英文字的大小寫時會判斷是一樣,如985M與985m
會判斷是相同,不知是什麼原因?
With .Sheets(sh)
For Each a In .Range(.[a2], .[a2].End(xlDown))
stcode = Mid(a, 1, 2)
   If stcode = mycode Then
      Set b = wbook.Columns("e").Find(a, lookat:=xlWhole)
            If b Is Nothing Then
               wbook.Range("e" & l).Resize(, 2) = a.Resize(, 2).Value
               wbook.Range("e" & l).Offset(, 2) = a.Offset(, 3).Value
               wbook.Range("e" & l).Offset(, 3) = a.Offset(, 4).Value
               l = l + 1
            Else
               b.Offset(, 2) = a.Offset(, 3).Value + b.Offset(, 2)
               b.Offset(, 3) = a.Offset(, 4).Value + b.Offset(, 3)
            End If
   Else
   End If
Next
End With

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

7^#

發表於 2011-9-1 07:17 | 顯示全部帖子

感謝GBKEE 大大...謝謝你.