Question

我已经包含了当前运行的基本代码，基本上根据更大的主列表（大约4000行乘36列）提取特定产品类别的信息。以前这不是一个问题，因为列出和提取到单张纸的唯一代码都是使用;但是，随着时间的推移，一些旧的指定产品编号将被停用，不再使用。我要做的就是修改现有的结构，以便它首先扫描主列表，以验证是否有任何行匹配c.Value和d.Value - 如果没有符合匹配c的行.Value和d.Value标准然后它应该只在循环内的If语句中执行操作（即删除旧工作表，创建一个新工作表，并使用通用的“项目代码未定位”值填充“G2”） ;如果找到符合c和d.value标准的任何行，那么它将经历正常过程。

<html>
  <head>
    <title>Design #1</title>
    <meta charset="UTF-8">
    <link href="style.css" rel="stylesheet">
  </head>
  <body>
    <div id="kopfbereich">
      <header>
        <div id="header_h">
          <h1>Fancy</h1>
          <h2>Testsite</h2>
        </div>
        <nav>
          <ul>
            <li><a href="#">Text</a></li>
            <li><a href="#">Text</a></li>
            <li><a href="#">Text</a></li>
            <li><a href="#">Text</a></li>
            <li><a href="#">Text</a></li>
          </ul>
        </nav>
      </header>
    </div>
  </body>
</html>

Answer 1

在我看来，您总是需要Item的新工作表。因此，首先创建新工作表，然后运行例程以查找并使用主工作表中的记录填充新工作表，并使用变量（Dim blItmFound As Boolean）标记何时找到任何记录，最后是否在哪里找不到记录，然后在G2新工作表中输入您想要的通用字符串（请参阅Rem Validate Records）。

请注意，我更改了"Item"以获取变量Item的值，并更改了此行：

Loop Until IsEmpty(c.Offset(0, -1))

为此：

Loop Until c.Value = Empty

有关详细信息，请参阅IsEmpty Function

这是您调整的代码：

Sub CreateDeptReport(Item As String)
Dim shtRpt As Excel.Worksheet, shtMaster As Excel.Worksheet, shtPrevious As Excel.Worksheet
Dim LCopyToRow As Long
Dim LCopyToCol As Long
Dim LastRow As Long
Dim arrColsToCopy
Dim c As Range, d As Range, e As Range, x As Integer
Dim blItmFound As Boolean

    arrColsToCopy = Array(1, 8, 3, 7, 9, 10, 39, 19, 24, 25, 27, 29, 33, 34, 35)

    Application.ScreenUpdating = False
    Set shtMaster = ThisWorkbook.Sheets("CurrentMaster")
    Set shtPrevious = ThisWorkbook.Sheets("PreviousMaster")
    Set c = shtMaster.Range("AI5")
    Set d = shtMaster.Range("H5")
    Set e = shtMaster.Range("X5")

    Rem Delete Item Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(Item).Delete
    Application.DisplayAlerts = True
    On Error GoTo Err_Execute

    Rem Add New Item Worksheet
    ThisWorkbook.Sheets("Template").Visible = xlSheetVisible
    ThisWorkbook.Sheets("Template").Copy After:=shtPrevious
    Set shtRpt = ThisWorkbook.Sheets(shtPrevious.Index + 1)
    shtRpt.Name = Item
    Range("G2").Value = Item
    Range("C3").Value = Date
    ThisWorkbook.Sheets("Template").Visible = xlSheetVeryHidden

    Rem Get Records from Master
    LCopyToRow = 11
    blItmFound = False
    Do
        If c.Value = 2516 _
            And d.Value = "37A" _
            And Not e.Value = "T1" _
            And Not e.Value = "T3" Then

            blItmFound = True
            LCopyToCol = 1
            shtRpt.Cells(LCopyToRow, LCopyToCol).EntireRow.Insert Shift:=xlDown
            For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)
                shtRpt.Cells(LCopyToRow, LCopyToCol).Value = c.EntireRow.Cells(arrColsToCopy(x)).Value
                LCopyToCol = LCopyToCol + 1
            Next x
            LCopyToRow = LCopyToRow + 1
        End If

        Set c = c.Offset(1, 0)
        Set d = d.Offset(1, 0)
        Set e = e.Offset(1, 0)

    Loop Until c.Value = Empty

    Rem Validate Records
    Select Case blItmFound
    Case True
        ThisWorkbook.Worksheets(Item).Rows("10:10").Delete
        LastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
        If LastRow <> 0 Then
            Rows(LastRow).EntireRow.Delete
        End If

    Case False
        ThisWorkbook.Worksheets(Item).Range("G2").Value = "Item: [" & Item & "] code not located"

    End Select

    Range("A9").Select
    Application.ScreenUpdating = True

Exit Sub

Err_Execute:
    MsgBox "An error occurred."

End Sub

Answer 2

根据我读过的内容，听起来你应该事先在各自的列中搜索这些值。这也假设如果其中一个条件为假，您将输入新代码。所以你可以这样做：

MainPage = new MainPage();

编辑：

Set cRange = shtMaster.Columns("AI:AI")
Set dRange = shtMaster.Columns("H:H")

If cRange.Find(2516) Is Nothing Or dRange.Find("37A") Is Nothing Then
    'do code when either one of these conditions is false

Else
    'both values are found in their respective columns
    'do existing code

当没有匹配条件的实例时，修改现有循环

2 个答案: