標題: 請問如何在資料檔各工作表做整理在查詢檔顯示出來? [打印本頁]

---

作者: flask    時間: 2011-8-21 17:22     標題: 請問如何在資料檔各工作表做整理在查詢檔顯示出來?

本帖最後由 flask 於 2011-8-22 19:09 編輯

請問如何在多個工作表將要的資料顯示出來?,我找一個工作表可以顯示,但多個工作表
就不知道如何用陣列處理,煩請大大解惑!
        With Sheets(c)
                    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
[attach]7542[/attach][attach]7543[/attach]

---

作者: flask    時間: 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")的工作表,再處理一次
請問如何處理一次就好,對於陣列資料真的很頭痛,感謝大大能幫我解惑!謝謝善心人士.

---

作者: GBKEE    時間: 2011-8-22 15:18

回復 1# flask
A,B 兩檔都要附上看看,才會知道如何構想

---

作者: flask    時間: 2011-8-22 19:12

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

---

作者: flask    時間: 2011-8-27 09:16

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

---

作者: Hsieh    時間: 2011-8-27 11:24

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Column = 2 Then
   
3.    If Target.Row > 4 And Target.Row < 15 Then
   
4.    If ActiveCell <> "" Then
   
5.    [E3] = ActiveCell.Value
   
6.    Ex [C1], [E1], Target
   
7.    Else
   
8.    End If
   
9.    End If
   
10. End If
    
11. End Sub
    
12. Sub Ex(s As Date, t As Date, mystr)
    
13. Dim Ay()
    
14. Application.ScreenUpdating = False
    
15. Set d = CreateObject("Scripting.Dictionary")
    
16. With Workbooks.Open(ThisWorkbook.Path & "\B08.xls") '兩檔為同一目錄
    
17. For Each sht In .Sheets
    
18. d(sht.Name) = 1
    
19. Next
    
20. For i = s To t
    
21. sh = Format(i, "yyyymmdd")
    
22. If d.exists(sh) = True Then
    
23. With .Sheets(sh)
    
24.    For Each a In .Range(.[B2], .[B2].End(xlDown))
    
25.    If InStr(a, mystr) > 0 Then
    
26.    ar = Array(a.Offset(, -1).Value, a.Value, a.Offset(, 2).Value, a.Offset(, 3).Value, a.Offset(, 2).Value - a.Offset(, 3).Value)
    
27.    ReDim Preserve Ay(x)
    
28.    Ay(x) = ar
    
29.    x = x + 1
    
30.    End If
    
31.    Next
    
32. End With
    
33. End If
    
34. Next
    
35. .Close
    
36. End With
    
37. With Sheet1
    
38. .[E5:I65536] = ""
    
39. If x > 0 Then .[E5].Resize(x, 5) = Application.Transpose(Application.Transpose(Ay))
    
40. End With
    
41. Application.ScreenUpdating = True
    
42. End Sub

複製代碼

回復 5# flask

---

作者: flask    時間: 2011-8-27 14:35

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

回復 6# Hsieh

謝謝Hsieh 超級版主真的簡潔好多,但是各工作頁沒做加總.
[attach]7619[/attach]
應該是像這樣
[attach]7618[/attach],
真的感謝你的幫忙,還有用廠商代碼做判別是因為廠商名稱有的會空白,這個
沒關係我知道如何用,謝謝你...

---

作者: flask    時間: 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

---

作者: GBKEE    時間: 2011-8-31 20:07

回復 8# flask
MatchCase     選擇性的 Variant。若指定為 True，則搜尋時大小寫視為相異。預設值為 False。
Set b = wbook.Columns("e").Find(a, lookat:=xlWhole, MatchCase:=True)

另一解法用進階篩選 帶入 多重準則  使用工作表資料庫函數( DSUM )計算進出貨

[attach]7655[/attach]

---

作者: flask    時間: 2011-9-1 07:17

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

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)