返回列表 上一主題 發帖

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

  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
學海無涯_不恥下問

TOP

        靜思自在 : 一句溫暖的話,就像往別人身上灑香水,自己會沾到兩三滴。
返回列表 上一主題