循環瀏覽所有工作表，如果cell = string，則將三個單元格復制到特殊工作表中

Question

我正在使用excel2007。我有一個發票系統，在其中輸入采購訂單編號，它會生成一個以po號為工作表名稱的新發票，並將其復制到同一工作表的單元格中，然后從那里它是手動填寫並保存的。 每個發票在單元格C6中具有十四種供應類型之一（例如，從下拉列表中選擇的打印供應或清潔供應）。 一切都很好。
我想跟蹤每種耗材類型花費了多少，因此我需要查看每張發票，檢查耗材類型並復制三個不連續的單元格（日期（A6：B6），po＃（F6：G6）和金額（G39））到該供應類型的“支票簿樣式”表中的一行。

我猜偽代碼看起來像這樣：

• 對於每張紙，檢查單元格c6中的耗材類型
• 如果正在打印耗材類型，
• 將三個單元格值在新行中寫入到名為“打印”的工作表中，否則繼續下一個
• 如果耗材類型是清潔的，
• 將三個單元格值在新行中寫入工作表Cleaning
• 以此類推，“如果”將自己殺死。

這就是我簡單地遍歷所有工作表並復制單元格而未按供應類型對它們進行排序的原因-然后，我試圖使其僅使用打印發票而沒有成功。

Sub CopyRangeFromPrintingWorksheets()


Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
'Delete the sheet "Printing" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Printing").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Printing"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
    'If sh.Name <> DestSh.Name Then
    If InStr(1, Worksheets(wks.Name).Range("C6:E6").Value, "Printing/Stationary 532-110", vbTextCompare) = 1 Then
    ' If LCase(Left(sh.Name, 4)) = "tly-" Then

        'Find the last row with data on the DestSh
        Last = LastRow(DestSh)

        'Fill in the range that you want to copy
        Set CopyRng = sh.Range("G3")


        'Test if there enough rows in the DestSh to copy all the data
        If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
            MsgBox "There are not enough rows in the Destsh"
            GoTo ExitTheSub
        End If

        'This copies values/formats, want to copy the
        'values or want to copy everything
        CopyRng.Copy
        With DestSh.Cells(Last + 1, "B")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With

        'Optional: This will copy the sheet name in the A column
        DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name
        'Copy ordered by cell to column C
        DestSh.Cells(Last + 1, "D").Resize(CopyRng.Rows.Count).Value = sh.Range("G39")
        'Copy date cell to proper column
        DestSh.Cells(Last + 1, "C").Resize(CopyRng.Rows.Count).Value = sh.Range("C6")
        DestSh.Cells(Last + 1, "E").Resize(CopyRng.Rows.Count).Value = sh.Range("E8")
    End If
Next

ExitTheSub:

Application.GoTo DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

我什至研究了精選案例，但仍然沒有成功。 試圖錄制marco並毫無靈感地看那個代碼。 似乎應該沒有那么難...但是我不知道最實用的方法。 指向正確方向的指針太棒了！

Answer 1

有可能在VBA中解決此問題，但這將非常麻煩且脆弱。

這種方法的一個問題是您將數據存儲在多個位置，這些數據可能會不同步。 另外，您需要三種不同的數據視圖：

• 單記錄視圖（即單個采購訂單）
• 多記錄視圖（即“支票簿樣式”），可能按供應類型分組或過濾
• 摘要視圖（給定日期范圍和/或供應類型的總計）

在Access或更嚴重的數據庫系統中，這樣做是微不足道的，但是稍加搜索使我相信，在Excel中，您可以得到以上兩個中的兩個，但不能同時獲得三個。 但是，以下鏈接可能會有所幫助：

您可以使用3-d引用對數據求和，但是我認為您不能從3-d引用（對於支票簿樣式的視圖）創建數據透視表：

http://office.microsoft.com/en-us/excel-help/create-a-3-d-reference-to-the-same-cell-range-on-multiple-worksheets-HP010102346.aspx

您還可以將多個工作表合並到數據透視表中，但是看起來源數據必須已經處於支票簿樣式的視圖中，因此無法獲取數據的單發票視圖：

http://office.microsoft.com/en-us/excel-help/consolidate-multiple-worksheets-into-one-pivottable-report-HA010226585.aspx

---

底線：如果您有時間專門解決此問題，建議將解決方案移至Access。

Answer 2

我得出的結論與phoog相同，但方向不同。 下面，我仔細研究了您的代碼，提出了一些更改建議，但是我很難相信您可以完成這項工作。

點1

您是否打開了多個工作簿？ 在運行宏之前，您是否要在它們之間切換？ 假設您打開了三個工作簿（A，B和C）。 同樣，假設此宏和發票在工作簿A中。如果在啟動宏時使用工作簿C，則C將為ActiveWorkBook。 可以跨多個工作簿運行宏，但是它增加了一定程度的復雜性，我相信您可以做到。 如果在啟動宏時僅打開一個工作簿，則不需要ActiveWorkbook. 。

點2

我不喜歡將On Error用作可以避免的錯誤。 這可能並不重要，但是刪除某些內容然后重新創建它對我來說是錯誤的。 我會這樣做：

Dim DestSh as Worksheet
Dim Found As Boolean
Dim InxWS As Integer

Found = False
For InxWS = 1 To Worksheets.Count
  If Worksheets(InxWS).Name = "Printing" Then
    Found = True
    ' Use whichever of the following two statements is most appropriate
    ' This completely deletes the contents of the worksheet
    Worksheets(InxWS).Cells.EntireRow.Delete
    ' This deletes the contents of the worksheet but keeps the column widths
    Worksheets(InxWS).Cells.EntireRow.ClearContents
    Exit For
  End If
Next
If Not Found Then
  Set DestSh = Worksheets.Add
  DestSh.Name = "Printing"
End If

點3

我發現以下內容沒有問題：

For Each sh In Worksheets
  If sh.Name <> DestSh.Name Then 


  End If
Next

For Each來說，這是工作表中的一種非常好的方法。

您需要一些檢查您不檢查工作表“打印”的方法。 但是，如果目標工作表總是要“打印”，則可以寫sh.Name <> "Printing" 。

另一方面，如果我想炫耀，我會寫：

Const DestShName as String = "Printing"
 :      :
DestSh.Name = DestShName
 :      :
If sh.Name <> DestShName Then 

使用此代碼，我可以通過更改Const（常量）語句來更改目標工作表的名稱。

點4

考慮：

Worksheets(wks.Name).Range("C6:E6").Value

什么是wks ？ for變量是sh ？

我猜您沒有Option Explicit作為模塊的第一行。 Option Explicit說您要禁止使用未聲明的變量。

Worksheets(sh.Name)與sh相同。

我假設“ C6：E6”已合並。 如果需要合並區域的值，請使用左上方的單元格。 所以Range("C6").Value 。

您的精選案例將采用以下形式：

With sh
  Select Case .Range("C6").Value
    Case "Printing"
      ' Do something
    Case "Cleaning"
      ' Do something
    Case "Stationary"
      ' Do something
    Case "Books"
      :     :
    Case Else
      ' Do something about an unknown supply type
  End Select
End With

點5

如果我理解正確，則您有14種耗材類型，每種類型都有其自己的目的地表。 在循環中，您將需要像這樣的Select Case來准備目標表。 供應類型與工作表名稱相同嗎？ 如果沒有，這將變得非常混亂，特別是如果您添加其他供應類型。

可能值得考慮數組。

Dim InxShST as Integer 
Dim SheetNameList() as String
Dim SupplyTypeList() as String

SheetNameList = Array("Print", "Clean", "Stat", ... )
SupplyTypeList = Array("Printing supplies", "Cleaning supplies", ... ) 

使用相同的工作表名稱和供應類型，您可以在采購訂單中找到供應類型並將其轉換為工作表名稱。 如果添加新的供應類型，只需在每個數組的末尾添加一個新值。

回到第2點。我建議您忘記通過VBA添加工作表； 手動創建14張紙。

代碼變為：

For InxWS = 1 To Worksheets.Count
  For InxShST = LBound(SheetNameList) To UBound(SheetNameList)
    If Worksheets(InxWS).Name = SheetNameList(InxShST) Then
      Worksheets(InxWS).Cells.EntireRow.ClearContents
      Exit For
    End If
  Next
Next

我承認這比較復雜，但是它可以根據您的需要准備很多張紙。 您有兩個循環：一個用於工作表，一個用於工作表名稱。 當您找到火柴時，便有一張需要清除的紙。 LBound代表下限。 UBound代表上限。 第二個For-Loop調整為數組的大小。

您可以使用：

  For Each SheetNameCrnt In SheetNameList

這看起來可能更簡單。 但是，通過使用索引，可以將SheetNameList(InxShST)與SupplyTypeList(InxShST)

其他要點

您確定要每個采購訂單一張工作表嗎？ 您一天有多少個采購訂單。 10？ 100？ 500？ 這可能是一個非常難以管理的工作簿。

根據宏中的其他語句，我假設您有一個固定的標頭，然后每個訂購的產品有一個數據行。 您沒有定義這些行的性質，但是我想您要將它們復制到適當的工作表中。

我也許可以猜測這些數據行的結構，但是我必須質疑您的設計。 如果我從您那里訂購了打印機墨盒和一些肥皂粉，是否需要兩份采購訂單？ 我認為您不會贏得我的生意。