Question

我正在学习如何在excell做VBA，我需要一些帮助。我一直在搜索这个网站，但没有找到一个我可以调整的例子来解决我的需求（或者至少我能理解的东西）。我正在尝试制作一个存档数据的按钮。我有两张纸，其中一张用于用户输入，另一张是存档位置。我希望在C列中取出值，然后根据表A和B中第1页的值的阀门将其超过表2中的匹配位置。

    Sheet 1

_ __ _ __ _ B_ _ ___ _C（用户输入值）

第1项 _ __ 日期 __ _ 5

第2项 _ __ 日期 ___ 8

第3项 _ __ 日期 ___ 2

     Sheet 2 (archive sheet)

_ __ _ __ B _ __ _ __ _ __ C _ __ _ ___ D

__ _ ____ 第1项 ___ 第2项 ____ 第3项

日期

我使用的方法是在第3张纸上复制第1张数据并运行vlookup，但如果用户将同一日期归档两次，则只能获得最新归档的值。我不确定循环是如何工作的，但我在其他人的要求中发现了我认为这样的东西可能会有所帮助。

任何见解都会非常感激。

Answer 1

如果您不知道循环如何工作，则必须学习Excel VBA的基础知识。你不能希望在不了解VBA的情况下将从互联网上收集的代码拼接在一起。

搜索＆＃34; Excel VBA教程＆＃34;。您将获得许多点击，其中许多将是免费的在线教程。这些教程的方法不同，所以请尝试一些，看看哪种最符合您的学习方式。或者，您可以前往一个好的书店或图书馆，在那里您可以找到各种Excel VBA Primers。我建议你建一个图书馆，这样你就可以在购买你最喜欢的图书之前先把几本书带回家。

您的规格中有许多漏洞。也许你有一个完整的规范，你没有在这里记录。如果您有完整的规格，请不要将其添加到您的问题中。对于像这样的网站，你需要一些小问题。

我发现的两个设计问题是：

为什么用=TODAY()填充日期列？如果存档宏未在当天结束时运行，则Excel将更改第二天运行宏的日期。使用日期值填充列或使用最近的VBA等效函数Now（）。
您暗示用户可能会输入项目A的计数，然后在当天晚些时候输入另一个计数。存档表将保留这两个计数的总和。这是怎么处理的？对于项目A，您可以有两行或更多行。用户可以在项目A行中输入新值之前运行存档宏。您可以使用工作表更改事件在用户输入后自动存档该值。

在尝试编写宏之前，您需要完全指定宏将要执行的操作以及将如何使用它。下面我提供了两个替代宏，它们实现了我认为是您需求的第一步：在数据输入工作表中找到有效行并提取准备好实现的值。

我建议你先学习基本的Excel VBA。这应该给你足够的知识来理解我的宏，即使第二个宏使用非基本语句。如有必要，请回答问题，但在提出这些问题之前请运行并尝试理解宏。

<强> demo1的

我创建了一个工作表＆＃34; Data Entry＆＃34;并填写与我对您的工作表的理解相符的数据＆＃34; Sheet1＆＃34;。请不要使用默认工作表名称，因为它非常混乱。用你选择的任何东西替换我的名字。

宏Demo1将有效行的值输出到立即窗口。写入立即窗口是一种在编写小代码时测试代码的便捷方法。

我已经记录了代码的作用，但没有记录VBA语句。一旦你知道一个陈述存在，通常很容易查找。

Option Explicit
Sub Demo1()

  Dim CountCrnt As Long
  Dim DateCrnt As Date
  Dim ItemCrnt As String
  Dim RowCrnt As Long
  Dim RowLast As Long

  With Worksheets("Data Entry")

    ' This sets RowLast to the last used row in column "C" or sets it to 1 if no
    ' row is used.  It is the VBA equivalent of positioning the cursor to the
    ' bottom of column C and clicking Ctrl+Up
    RowLast = .Cells(Rows.Count, "C").End(xlUp).Row

    ' I have assumed the first data row is 2
    For RowCrnt = 2 To RowLast
      ' I have allowed for column C being empty.  I assume such rows are
      ' to be ignored.  I also ignore rows with invalid values in columns
      ' B or C.
      If .Cells(RowCrnt, "C").Value <> "" And _
         IsNumeric(.Cells(RowCrnt, "C").Value) And _
         IsDate(.Cells(RowCrnt, "B").Value) Then
        ' Extract the validated values to variables ready for the next stage
        ' of processing.
        ItemCrnt = .Cells(RowCrnt, "A").Value
        DateCrnt = .Cells(RowCrnt, "B").Value
        CountCrnt = .Cells(RowCrnt, "C").Value
        ' Output row values to Immediate Window
        Debug.Print RowCrnt & "  " & ItemCrnt & "  " & _
                    Format(DateCrnt, "dmmmyy") & "  " & CountCrnt
      End If
    Next

  End With

End Sub

<强> DEMO2

Macro Demo2实现与宏Demo1相同，但方式不同。

Demo1分别访问工作表中的单元格。 Demo2复制整个工作表到Variant，然后可以作为2D数组访问。单个单元格访问速度要快得多，如果只需要单元格值，通常会更方便。

Demo1将值输出到立即窗口。这对于少量输出非常方便，但是对于较大的量，早期的线路将会丢失。 Demo2在与工作簿相同的文件夹中创建一个文件，并将输出写入该文件，这样就不会丢失任何内容。

Sub Demo2()

  Dim CountCrnt As Long
  Dim DateCrnt As Date
  Dim FileOutNum As Long
  Dim ItemCrnt As String
  Dim RowCrnt As Long
  Dim RowLast As Long
  Dim SheetValue As Variant

  FileOutNum = FreeFile

  Open ActiveWorkbook.Path & "\Demo2.txt" For Output As #FileOutNum

  With Worksheets("Data Entry")
    ' This statement converts Variant SheetValue to an appropriately sized
    ' two-dimensional array and copies the values from the entire used
    ' range of the worksheet to it.
    SheetValue = .UsedRange.Value
    ' Standard practice for 2D arrays is to have the first dimension for
    ' columns and the second for rows.  For arrays copied from or to
    ' worksheets, the first dimension is for rows and the second is for
    ' columns.  This can be confusing but means that array elements are
    ' accessed as SheetValue(Row, Column) which matches Cells(Row, Column).
    ' Note that the lower bounds for both dimensions are always one. If the
    ' range copied from the worksheet starts at Cell A1, row and column
    ' numbers for the array will match those of the worksheet.

  End With

  For RowCrnt = 2 To UBound(SheetValue, 1)

    ' I have allowed for column 3 (= "C") being empty.  I assume such rows
    ' are to be ignored.  I also ignore rows with invalid values in columns
    ' 2 (= "B") or 3.
    If SheetValue(RowCrnt, 3) <> "" And _
       IsNumeric(SheetValue(RowCrnt, 3)) And _
       IsDate(SheetValue(RowCrnt, 2)) Then
      ItemCrnt = SheetValue(RowCrnt, 1)
      DateCrnt = SheetValue(RowCrnt, 2)
      CountCrnt = SheetValue(RowCrnt, 3)
      ' Output row values to file
      Print #FileOutNum, RowCrnt & "  " & ItemCrnt & "  " & _
                         Format(DateCrnt, "dmmmyy") & "  " & CountCrnt
    End If
  Next

  Close #FileOutNum

End Sub

修改新部分以回应补充问题。

正如您所发现的，没有办法打印＆＃34;到工作表，但很容易写入单个单元格。我使用过诊断工作表，但我通常认为这种技术比它的价值更麻烦。输出到文件更容易添加，更容易删除，并且不会干扰代码。

以下代码的顺序正确，但我在块之间添加了解释。

Dim RowDiagCrnt As Long

上述语句不在子程序中，该子程序使得可以从任何例程访问的是gloabl变量。如果有几个例程需要输出诊断信息，那么对行号使用全局变量比从父例程中将其作为参数传递更容易。

我有一个命名变量的系统，＆＃34; Row＆＃34;意味着这是一排。＆＃34; Diag（诊断）＆＃34;识别工作表＆＃34;。＆＃34; CRNT＆＃34;将此标识为当前行号。在Demo1中，我有RowCrnt，因为我只有一个工作表。你可能不喜欢我的系统。很好，发展自己的。有一个系统意味着我可以看看我几年前写的一个宏，并知道所有变量是什么。这使得维护变得更加容易。

Sub Demo3()

  Dim CountCrnt As Long
  Dim DateCrnt As Date
  Dim ItemCrnt As String
  Dim RowDiagCrnt As Long
  Dim RowEntryCrnt As Long
  Dim RowEntryLast As Long
  Dim ValidRow As Boolean
  Dim WkshtDiag As Worksheet
  Dim WkshtEntry As Worksheet

我现在有两个工作表，我将不得不在它们之间切换。我不喜欢Worksheets("Xxxxx")的多种用途，因为我可能会更改＆＃34; Xxxxx＆＃34;。引用可以避免多次使用名称，并且速度更快。

  Set WkshtEntry = Worksheets("Data Entry")
  Set WkshtDiag = Worksheets("Diagnostics")

  ' Delete existing contents of diagnostic worksheet and create header row
  With WkshtDiag
    .Cells.EntireRow.Delete
    .Cells(1, "A").Value = "Row"
    .Cells(1, "B").Value = "Item"
    .Cells(1, "C").Value = "Date"
    .Cells(1, "D").Value = "Count"
  End With

  RowDiagCrnt = 2

  With WkshtEntry
    RowEntryLast = .Cells(Rows.Count, "C").End(xlUp).Row
  End With

  For RowEntryCrnt = 2 To RowEntryLast

如果我想使用With语句，我必须将对两个工作表的访问权分开。我使用布尔值来处理这个问题。

    With WkshtEntry
      If .Cells(RowEntryCrnt, "C").Value <> "" And _
         IsNumeric(.Cells(RowEntryCrnt, "C").Value) And _
         IsDate(.Cells(RowEntryCrnt, "B").Value) Then
        ItemCrnt = .Cells(RowEntryCrnt, "A").Value
        DateCrnt = .Cells(RowEntryCrnt, "B").Value
        CountCrnt = .Cells(RowEntryCrnt, "C").Value
        ValidRow = True
      Else
        ValidRow = False
      End If
    End With

    If ValidRow Then
      With WkshtDiag
        ' Output row values to Diagnostic worksheet
        .Cells(RowDiagCrnt, "A").Value = RowEntryCrnt
        .Cells(RowDiagCrnt, "B").Value = ItemCrnt
        With .Cells(RowDiagCrnt, "C")
          .Value = DateCrnt
          .NumberFormat = "dmmmyy"
        End With
        .Cells(RowDiagCrnt, "D").Value = CountCrnt
        RowDiagCrnt = RowDiagCrnt + 1
      End With
    End If

  Next

  ' Set columns to appropriate width for contents
  With WkshtDiag
    .Columns.AutoFit
  End With

End Sub

我希望您能看到我为Demo1创建Demo3所做的所有更改的原因。拥有最终解决方案不需要的第二个工作表会增加我通常希望避免的复杂性。

VBA根据其他值复制和粘贴位置值

1 个答案: