我对Excel很熟悉,但对VBA很陌生,我希望能得到任何帮助。我确实在Excel先生上发表过文章,但没有得到任何帮助,所以我想我应该在这里试试。
我想自动化我的每月财务跟踪。我目前定期下载我的帐户活动,手动分类,然后将其分为分类部分,以便我可以跟踪每个类别的支出金额。看起来我可能会下载我的帐户活动,仍然手动分类,然后运行VBA将分类数据从一个选项卡复制到另一个选项卡(作为新行)。
Sheet 4 =我将粘贴帐户活动数据的位置(手动删除重复项并分类)
Sheet 3 =希望VBA粘贴新数据行的位置(可能粘贴到相应节的顶部)
例如:Hulu收费在表4的D列中被归类为“TV Streaming”,因此来自列A-C的数据将作为新行粘贴在表3的TV Streaming部分下。
我确实利用了我在网上找到的一些代码here,它几乎做到了我想要的,但我还剩下两件事。
1.它只搜索Rx/Dr类别,可能是因为我在第19行(Sheet 3)指定了单元格“A2”。是否有办法对A列中的任何类别进行变量搜索?
1.行按照我想要的顺序(从最旧到最新)复制,但它们没有将自己作为新行插入,而是粘贴到其他类别中。我可以向代码中添加什么来告诉它插入复制的单元格,而不仅仅是粘贴它们?
Sub CopyRows()
' 1. Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' 2. Source
' Calculate the source last row ('slRow'),
' the row of the last non-empty cell in the column.
Dim slRow As Long: slRow = Sheet4.Cells(Sheet4.Rows.Count, "D").End(xlUp).Row
' Reference the source columns range ('scrg') whose rows will be copied.
Dim scrg As Range: Set scrg = Sheet4.Columns("A:C")
' 3. Destination
' Reference the first destination row range by resizing the first
' destination cell by the number of columns of the source columns range.
Dim drrg As Range: Set drrg = Sheet3.Range("B3").Resize(, scrg.Columns.Count)
' Write the lookup string value to a string variable ('dlString').
Dim dlString As String: dlString = CStr(Sheet3.Range("A2").Value)
' 4. The Loop
' Declare additional variables.
Dim srrg As Range ' Current Source Row Range
Dim sr As Long ' Current Row in the Source Worksheet
Dim slString As String ' Current String Lookup String
' Loop through the designated rows of the source worksheet.
For sr = 3 To slRow
' Write the source string value in the current row to a variable.
slString = CStr(Sheet4.Cells(sr, "D").Value)
' Compare the string in the current row against the lookup string.
' The comparison is case-insensitive i.e. 'dog = DOG'
' due to the 'vbTextCompare' parameter.
If StrComp(slString, dlString, vbTextCompare) = 0 Then ' is equal
' Reference the source row range.
Set srrg = scrg.Rows(sr)
' Write the values from the source row range
' to the destination row range ('copy by assignment').
drrg.Value = srrg.Value
' Reference the next destination row range (one row below).
Set drrg = drrg.Offset(1)
'Else ' is not equal; do nothing
End If
Next sr
' 5. Inform to not wonder if the code has run or not.
MsgBox "Rows copied.", vbInformation
End Sub
1条答案
按热度按时间sr4lhrrt1#
1.要查找类别所在的第一行:
Dim CategoryRow as Range
Set CategoryRow = Sheet3.Range("A:A").Find(value).EntireRow
CategoryRow.Entirerow.Insert
您可能还需要考虑使用ListObjects(表)。由于各种原因,它会更有用。
仍然不知道如何发布“代码”。