2

我想做的是拿出我的预算表并按特定顺序对其进行排序。这正是我所拥有的：

A 列 = 预算项目名称（账单和支付）

B 列 = 该项目到期的月份中的哪一天。

C 列 = 该项目的金额。

我想创建一些VBA代码，当按下按钮时，它将从这些列中获取该信息，并在 B 列中按天排序，如下所示：

1 - PayDay - 1000
4 - Cell Phone - 75
5 - Mortgage - 1350

编辑：

我一直在研究这个 VBA。只需要弄清楚如何放入排序函数，以便按天列对我的结果进行排序。

Sub CreateList()

' Clear the current records
currentRow = 2
While currentRow < 200

    If IsEmpty(Worksheets("Jan").Cells(currentRow, 9)) Then
    GoTo Generate
    End If

    Worksheets("Jan").Cells(currentRow, 9).Value = ""
    Worksheets("Jan").Cells(currentRow, 10).Value = ""
    Worksheets("Jan").Cells(currentRow, 11).Value = ""
    Worksheets("Jan").Cells(currentRow, 12).Value = ""

    currentRow = currentRow + 1
Wend

Generate:

' Generate new list

titleCol = 1
dayCol = 2
amountCol = 3

currentListRow = 2

currentSheet = 1
While currentSheet < 2

    currentRow = 7
    cellVal = ""

    While currentRow < 800

    cellVal = Worksheets("Jan").Cells(currentRow, dayCol).Text

        If Not IsEmpty(cellVal) Then
            If Not cellVal = "0" Then
                If Not cellVal = "" Then
                If Not cellVal = "Due Date" Then

                    ' Set vals in list cells
                    Worksheets("Jan").Cells(currentListRow, 10).Value = Worksheets("Jan").Cells(currentRow, dayCol).Text
                    Worksheets("Jan").Cells(currentListRow, 9).Value = Worksheets("Jan").Cells(currentRow, titleCol).Text
                    Worksheets("Jan").Cells(currentListRow, 11).Value = Worksheets("Jan").Cells(currentRow, amountCol).Text


                    currentListRow = currentListRow + 1

        End If
        End If
        End If
        End If

        currentRow = currentRow + 1
    Wend

    currentSheet = currentSheet + 1
Wend

End Sub
4

3 回答 3

1

在Whytheq 的帮助下，我想出了这个解决方案。第一个 Sub 将字段复制到新区域。第二个子按天列对新创建的列表进行排序。第三个子项更改了任何新创建的未标记为我或我妻子姓名的列表项，并使它们成为负数。我这样做是为了在新列表的右侧添加一个字段，该字段执行与每个列表项相关的数学运算，以调整在支付每笔账单或添加每笔付款后我们剩下的金额。

Option Explicit
Sub CreateList()

' Clear the current records
Dim currentRow  As Integer '<<always declare variables
currentRow = 2
While currentRow < 200 And Not IsEmpty(Worksheets("Jan").Cells(currentRow, 9)) '<<best to not use goto unless no other way of coding it

Worksheets("Jan").Cells(currentRow, 9).Value = ""
Worksheets("Jan").Cells(currentRow, 10).Value = ""
Worksheets("Jan").Cells(currentRow, 11).Value = ""

currentRow = currentRow + 1
Wend

' Generate new list
Dim titleCol As Integer, dayCol As Integer, amountCol As Integer, cellVal As String

Dim currentListRow As Integer, currentSheet As Integer

titleCol = 1
dayCol = 2
amountCol = 3

currentListRow = 3

currentSheet = 1
While currentSheet < 2

    currentRow = 7

    While currentRow < 800

    cellVal = Worksheets("Jan").Cells(currentRow, dayCol).Text

        If Not IsEmpty(cellVal) And Not cellVal = "0" And Not cellVal = "" And Not cellVal = "Due Date" Then

                    ' Set vals in list cells
                    Worksheets("Jan").Cells(currentListRow, 10).Value = Worksheets("Jan").Cells(currentRow, dayCol).Text
                     Worksheets("Jan").Cells(currentListRow, 9).Value = Worksheets("Jan").Cells(currentRow, titleCol).Text
                       Worksheets("Jan").Cells(currentListRow, 11).Value = Worksheets("Jan").Cells(currentRow, amountCol).Text
                       currentListRow = currentListRow + 1

        End If

        currentRow = currentRow + 1
    Wend

    currentSheet = currentSheet + 1
Wend
Call Sort
End Sub
Public Sub Sort()

Dim oneRange As Range
 Dim aCell As Range

Set oneRange = Range("I3:K40")
 Set aCell = Range("J3")

oneRange.Sort Key1:=aCell, Order1:=xlAscending, Header:=xlGuess

Call Negative
End Sub
Public Sub Negative()
Dim titlesCol As Integer, daysCol As Integer, amountsCol As Integer, cellVal As String
Dim currentListRow As Integer, currentSheet As Integer, currentRow  As Integer

 titlesCol = 9
 amountsCol = 11
 currentListRow = 3

currentSheet = 1
While currentSheet < 2

    currentRow = 3
    cellVal = ""

    While currentRow < 41

    cellVal = Worksheets("Jan").Cells(currentRow, titlesCol).Text

             If Not cellVal = "Alisa" Then
                If Not cellVal = "Jordan" Then

                    ' Multiply by Negative 1
                    Worksheets("Jan").Cells(currentRow, 11).Value = Worksheets("Jan").Cells(currentRow, 11).Value * -1

                    currentListRow = currentListRow + 1

        End If
        End If

        currentRow = currentRow + 1
    Wend

    currentSheet = currentSheet + 1
Wend
 End Sub
于 2013-01-02T15:25:39.960 回答
0

这是一个解决方案，只需将此宏附加到您放在工作表上的按钮即可。我只是录制了一个宏，然后将其修改为不太特定于上下文......

此解决方案假定数据或标题从活动工作表的单元格 A1 开始，并且没有空行或空列穿插。

如果要更改排序列，只需更改对“B”的引用。

如果添加列，则将对“C”的引用更改为排序区域中的最后一列，或者更好地更新代码以检测所选范围内的最后一列，类似于我确定最后一行的方式......

祝你好运！

Public Sub SortByDescription()
Dim Rng As Range, Ws As Excel.Worksheet, LastRow As Long
    Set Ws = ThisWorkbook.ActiveSheet
    Set Rng = Ws.Range("A1")
    Ws.Range(Rng, Rng.End(xlToRight)).Select
    Set Rng = Ws.Range(Selection, Selection.End(xlDown))
    LastRow = Rng.End(xlDown).Row
    Ws.Sort.SortFields.Clear
    Ws.Sort.SortFields.Add Key:=Range("B1:B" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Ws.Sort
        .SetRange Range("A1:C" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Ws.Range("A1").Select
End Sub
于 2013-01-02T00:18:46.850 回答
0

没有回答您的问题，但只是快速浏览了您的代码，并且有一些明显的改进：

Option Explicit   '<<best to use this in all modules; 

Sub CreateList()

' Clear the current records
Dim currentRow  As Integer '<<always declare variables
currentRow = 2
While currentRow < 200 And Not IsEmpty(Worksheets("Jan").Cells(currentRow, 9)) '<<best to not use goto unless no other way of coding it

    Worksheets("Jan").Cells(currentRow, 9).Value = ""
    Worksheets("Jan").Cells(currentRow, 10).Value = ""
    Worksheets("Jan").Cells(currentRow, 11).Value = ""
    Worksheets("Jan").Cells(currentRow, 12).Value = ""

    currentRow = currentRow + 1
Wend


' Generate new list
Dim titleCol As Integer, dayCol As Integer, amountCol As Integer
Dim currentListRow As Integer, currentSheet As Integer

titleCol = 1
dayCol = 2
amountCol = 3

currentListRow = 2

currentSheet = 1
While currentSheet < 2

    currentRow = 7
    cellVal = ""

    While currentRow < 800

        cellVal = Worksheets("Jan").Cells(currentRow, dayCol).Text

        If Not IsEmpty(cellVal) And Not cellVal = "0" And Not cellVal = "" And Not cellVal = "Due Date" Then  '<<all conditions seem to be able to go in one IF

            ' Set vals in list cells
            Worksheets("Jan").Cells(currentListRow, 10).Value = Worksheets("Jan").Cells(currentRow, dayCol).Text
            Worksheets("Jan").Cells(currentListRow, 9).Value = Worksheets("Jan").Cells(currentRow, titleCol).Text
            Worksheets("Jan").Cells(currentListRow, 11).Value = Worksheets("Jan").Cells(currentRow, amountCol).Text
            currentListRow = currentListRow + 1

        End If

    currentRow = currentRow + 1
    Wend

currentSheet = currentSheet + 1
Wend

Call SortByDescription

End Sub

Public Sub SortByDescription()
Dim Rng As Range, Ws As Excel.Worksheet, LastRow As Long
    Set Ws = ThisWorkbook.ActiveSheet
    Set Rng = Ws.Range("A1")
    Ws.Range(Rng, Rng.End(xlToRight)).Select
    Set Rng = Ws.Range(Selection, Selection.End(xlDown))
    LastRow = Rng.End(xlDown).Row
    Ws.Sort.SortFields.Clear
    Ws.Sort.SortFields.Add Key:=Range("B1:B" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Ws.Sort
        .SetRange Range("A1:C" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Ws.Range("A1").Select
End Sub

该Option Explicit行非常重要，您可以将编辑器设置为始终自动在所有模块中包含该行。当您在IDEsTool菜单中选择Options并选择选中“需要变量声明”

我已将@Tahbaza 例程添加到您的代码底部 - 在您底部的代码中，我已添加Call SortByDescription以调用排序例程。

在此处输入图像描述

于 2013-01-02T12:59:11.090 回答