Excel VBA - 有关比较范围和数组的帮助

时间：2011-10-20 07:53:19

标签： excel vba

我有这个工作簿，我一直试图通过宏代码开始工作。我已经得到了一些帮助，但似乎没有人理解我在追求什么。这是一本工作簿，用于跟踪和记录我们公司每个用户收到的工作服的数量。所以，基本上，我在这个工作簿中有三张：https://skydrive.live.com/view.aspx?cid=5D018DB0458F03ED&resid=5D018DB0458F03ED%21163

  • 摘要
  • 用户
  • 文章

一般的想法是我将从摘要表中的数据创建数据透视表。但我希望使用vba代码使工作簿变得动态。所以我会在这里查看每张表。

用户：此工作簿只包含一列（A），A1称为“名称”，其下的每行包含公司中的每个用户。

文章：此工作簿包含两列，A1是文章的名称（裤子等），另一列是该项目的价格。

总结：这是棘手的部分。此工作表应该反映其他两个工作表中的数据，但我需要跟踪每个用户收到的每个项目的数量。我将这些数据保存在摘要表中的D列中。因此，“用户”表中的每个名称都需要重复与“文章”表单中的项目一样多次。如果文章表中有10个项目，则该名称必须重复10次。这样，我可以说用户收到的每个项目中有多少。

因此，棘手的部分是实际镜像用户和文章表中的内容，但仍保留摘要表中D列的数据。另请注意，如果从“用户”工作表中删除一行，则需要从“摘要表”中完全删除该用户，包括已注册的每个项目的数量。如果我在“文章”表单中添加项目，则需要在“摘要”表单中为每个用户添加该项目。

我有一些有人帮助我的宏代码，但我并没有真正了解到的情况。我对数组和循环并不坚固。这就是我现在想要学习的东西，因为我看到了学习它的潜力。

然而，我确实需要从他们自己的范围内的所有工作表中收集数据，存储所有数据。然后我需要将用户范围与摘要范围进行比较，以查看用户是否在该范围内。如果是，请确保更新文章范围中的数据以及保留ColumnD中的数量。如果它不在摘要表中，请添加它。每个项目也是如此。

但是，如果我输错了用户并且在我为该用户添加金额之后才意识到这一点怎么办？如果我然后返回用户工作表并重命名用户，我是否会丢失之前添加的所有数据？或者是否也可以重命名用户？在这种情况下，我可能需要为每个用户提供某种ID，就像Windows中的CID一样？这有点太过分了吗？这一切都归结为它在时间上更有价值。我真的很感激一些帮助：）

Public Sub NewCollect()
' Declare variables
Dim shtUsers, shtmyArticles, shtmySummary, shtmyAmount As Worksheet
Dim arrUsers, arrarticles, arramount, arrsummary As Long

' Set worksheets
Set shtUsers = Sheets("Brukere")
Set shtArticles = Sheets("Artikler")
Set shtSummary = Sheets("Oppsummering")
Set shtAmount = Sheets("Antall")

' Get range from shtUsers
With shtUsers
    If Not .Range("A2") = "" Then
        arrUsers = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    End If
End With

' Get range from shtArticles
With shtArticles
    If Not .Range("A2") = "" Then
        arrarticles = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 3)
    End If
End With

' Get range from shtAmount (The new sheet)
With shtAmount
    If Not .Range("A2") = "" Then
        arramount = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    End If
End With

' Get range from shtSummary
With shtSummary
    If Not .Range("A2") = "" Then
        'Here I have no idea where to even begin
    Else
        ' If Summary sheet is blank, get data from other sheet and insert
        ReDim tempArr(1 To UBound(arrUsers) * UBound(arrarticles), 1 To 6)
        For u = 1 To UBound(arrUsers)
            For i = 1 To UBound(arrarticles)
                j = j + 1
                tempArr(j, 1) = arrUsers(u, 1)
                tempArr(j, 2) = arrUsers(u, 2)
                tempArr(j, 3) = arrarticles(i, 1)
                tempArr(j, 4) = arrarticles(i, 2)
                tempArr(j, 6) = arrarticles(i, 3)
            Next
        Next
        ' Add the data
        .Range("A2").Resize(j, 6).Value = tempArr
    End If
End With

编辑：我刚向用户和文章页面添加了一个新列，其中我可以为每个项目添加ID。现在更新了我的SkyDrive上的实际工作表。

1 个答案:

答案 0 :(得分：3)

首先，我要完全将输入与输出分开。这是基于经验，因为我在几年前为会计师编制了一个相当复杂的会计电子表格，作为总帐和P＆amp; L.

控制信息在一张纸上，GL代码在另一张纸上，交易在另一张纸上，一张宏基本上已经完成并在其他四张纸上创建了汇总和明细资产负债表以及收入/支出报表。

原始尝试试图操纵输入端的信息，但结果却是一场噩梦。输入和输出分离后，管理变得更加容易。

换句话说，请使用以下表格：

  • 人
  • 产品。
  • 交易。
  • 输出

前三个只是输入。交易是一个列表，列出了什么项目给了什么人（多对多关系）。然后我会有一个宏，其执行如下。

首先，完全清除第四张（输出）。然后，对于人员表中的每个活动人员，请浏览交易表并为附加到该人的任何交易创建输出条目。

顺便说一句，我之前说'活跃'，因为你可能想保留历史记录，为已离开的人保留记录。那将是People表中的某种旗帜。

您可能需要在此过程中查找商品和价格。

您也可以将错误报告为宏的一部分，例如没有有效人员或项目的交易条目。

您可能还想考虑某些人/物品可能具有相同名称的可能性（即使是相同的物品也可能会定期更改价格）。为此，向每个人和项目附加一个唯一的ID可能是明智的，以确保不会出现错误识别的可能性。这些唯一ID将存储在交易表中。

由于我讨论的宏在37K的重量，我不能在这里发布。但这是处理交易表并使用余额更新帐户页面的主要处理位：

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Option Explicit

Public Const TxnSheet = "Txns"
Public Const TxnColId = "a"
Public Const TxnColDate = "b"
Public Const TxnColAcct = "c"
Public Const TxnColAmt = "d"
Public Const TxnColDesc = "e"
Public Const TxnColNotes = "f"
Public Const TxnRowStart = "2"

Public Const AcctSheet = "Accts"
Public Const AcctColReport = "a"
Public Const AcctColType = "b"
Public Const AcctColBold = "c"
Public Const AcctColItalic = "d"
Public Const AcctColFontPlus1 = "e"
Public Const AcctColOther2 = "f"
Public Const AcctColOther3 = "g"
Public Const AcctColOther4 = "h"
Public Const AcctColOther5 = "i"
Public Const AcctColLevel = "j"
Public Const AcctColSign = "k"
Public Const AcctColAcct = "l"
Public Const AcctColVal = "m"
Public Const AcctColNotes = "n"
Public Const AcctRowStart = "2"

' Process all transactions.

Sub ProcessTransactions()
    Dim TxnId As Integer
    Dim Balance As Double
    Dim WsTxn As Worksheet
    Dim WsAcct As Worksheet

    Dim RowTxn As String
    Dim RowAcct As String

    Dim RowTxn2 As String
    Dim RowTxn3 As String

    Dim StartDate As Date
    Dim EndDate As Date
    Dim CutoffDate As Date
    Dim PastCutoff As Boolean

    ' Get user-configurable stuff

    StartDate = GetConfig("start_date")
    EndDate = GetConfig("end_date")
    CutoffDate = GetConfig("cutoff_date")
    PastCutoff = False

    ' For filling in transaction IDs.

    TxnId = 1

    Set WsTxn = Worksheets(TxnSheet)
    Set WsAcct = Worksheets(AcctSheet)
    RowTxn = TxnRowStart


    ' Select the worksheet and cell so we can see what's happening.

    WsTxn.Select
    Range(TxnColAcct + RowTxn).Select
    Range(TxnColAcct + RowTxn).Show

    ' Process all transaction lines.

    Do While Range(TxnColAcct + RowTxn).Value <> ""
        ' Check for start of transaction (non-blank date).

        If Range(TxnColDate + RowTxn).Value <> "" Then
            ' Check date within range.

            If Range(TxnColDate + RowTxn).Value < StartDate Or Range(TxnColDate + RowTxn).Value > EndDate Then
                Range(TxnColDate + RowTxn).Select
                MsgBox "ERROR: ProcessTransactions: Date out of range"
                End
            End If

            If Range(TxnColDate + RowTxn).Value > CutoffDate Then
                PastCutoff = True
            End If

            ' Start of transaction, fill in transaction ID and increment.

            Range(TxnColId + RowTxn).Value = TxnId
            TxnId = TxnId + 1

            ' Check that transaction is balanced.

            RowTxn2 = FindNextTxn(RowTxn)
            RowTxn3 = PrevRow(RowTxn2)

            Balance = 0
            Do While RowTxn2 <> RowTxn
                RowTxn2 = PrevRow(RowTxn2)
                Balance = Balance + Range(TxnColAmt + RowTxn2).Value
            Loop
            If Balance > 0.001 Or Balance < -0.001 Then
                Range(TxnColAmt + RowTxn + ":" + TxnColAmt + RowTxn3).Select
                MsgBox "ERROR: ProcessTransactions: Unbalanced transaction"
                End
            End If
        Else
            ' Not transaction start, clear transaction ID column.

            Range(TxnColDate + RowTxn).Clear
        End If

        ' Get account line, error if account not in accounts worksheet.

        RowAcct = FindAccount(Range(TxnColAcct + RowTxn).Value)
        If RowAcct = "" Then
            MsgBox "ERROR: ProcessTransactions: Invalid account '" & Range(TxnColAcct + RowTxn).Value & "'"
            End
        End If

        ' Update accounts value.

        If Not PastCutoff Then
            WsAcct.Range(AcctColVal + RowAcct) = WsAcct.Range(AcctColVal + RowAcct) + Range(TxnColAmt + RowTxn).Value
        End If

        ' Move to next transaction.

'        Sleep 50
        RowTxn = NextRow(RowTxn)
        Range(TxnColAcct + RowTxn).Select
        Range(TxnColAcct + RowTxn).Show
    Loop

    Range(TxnColDate + RowTxn).Select
    Range(TxnColDate + RowTxn).Show
End Sub

如果不了解工作表布局，它可能没那么有用，但如果不能向您发送整个工作簿，这是我能做的最好的。

相关问题
最新问题