excel vba将数据放入错误的单元格

时间：2014-08-05 04:58:07

标签： excel vba excel-vba

我有一个输入表（“按月”），用户将数据输入到某些单元格中，然后将该数据分类为两个单独的电子表格（“ordersbyLOGdate”和“ordersbySHIPdate”） - 您可以猜测这些电子表格包含相同的内容数据，但对它们进行不同的排序（按日志日期，然后按发货日期）。

我可以很好地阅读和存储数据，但是在对数据进行排序并将其放入电子表格时，它并没有结束我希望它去的地方，任何人都能看到我在这里缺少的东西吗？

Sub Button1_Click()
Dim countR As Long
Dim countLoop As Long
countLoop = 1

countR = firstBlankRow(ThisWorkbook.Worksheets("by month"))
countR = countR - 1
Dim colL As String
Dim company As String
Dim orderNumb As String
Dim oDate As Date
Dim total As Double
Dim orderStatus As String
Dim shipMethod As String
Dim sDate As Date    
Dim orderStock As String    

For i = 2 To countR 'countR is the first row down with nothing in it (leng = 0) and then - 1 (to get the next row up)... that's how many rows have inputs in them that need to be stored
    ThisWorkbook.Worksheets("by month").Activate
    company = Range("A" & i).Value
    orderNumb = Val(Range("B" & i).Value)
    oDate = Range("C" & i).Value
    total = Val(Range("D" & i).Value)
    orderStatus = (Range("E" & i).Value)
    shipMethod = Range("I" & Count).Value
    sDate = Range("J" & i).Value
    orderStock = Range("K" & i).Value
    Dim LL As Long
    LL = Range("D" & Rows.Count).End(xlUp).Row + 1 + 1

    ThisWorkbook.Worksheets("ordersbyLOGdate").Activate
    Dim rowN As Integer
    rowN = 2
    Do Until Range("C" & rowN).Value >= oDate Or rowN = 10000 '10,000 stops infinite row checking
    rowN = rowN + 1
    Loop 'once loop finishes we should have found a place to insert data, insert a row and place data inside the row
    If Range("C" & rowN).Value = oDate Then
        Range("A" & rowN).EntireRow.Insert
        Range("A" & rowN).Value = company
        Range("B" & rowN).Value = orderNumb
        Range("C" & rowN).Value = oDate
        Range("D" & rowN).Value = total
        Range("E" & rowN).Value = orderStatus
        Range("I" & rowN).Value = shipMethod
        Range("J" & rowN).Value = sDate
        Range("K" & rowN).Value = orderStock
    End If
    If Range("C" & rowN).Value > oDate Then
        Debug.Print ("compare date is GREATER than oDate, - 1 from rowN and insert data there")
        Range("A" & rowN).EntireRow.Insert
        Range("A" & rowN).Value = company
        Range("B" & rowN).Value = orderNumb
        Range("C" & rowN).Value = oDate
        Range("D" & rowN).Value = total
        Range("E" & rowN).Value = orderStatus
        Range("I" & rowN).Value = shipMethod
        Range("J" & rowN).Value = sDate
        Range("K" & rowN).Value = orderStock
    End If
    If rowN = 10000 Then
        MsgBox ("ERROR")
        Exit Sub
    End If

    ThisWorkbook.Worksheets("ordersbySHIPdate").Activate
    rowN = 2
    Do Until Range("C" & rowN).Value >= sDate Or rowN = 10000
        rowN = rowN + 1
    Loop
    If Range("C" & rowN).Value = sDate Then
        Range("A" & rowN).EntireRow.Insert
        Range("A" & rowN).Value = company
        Range("B" & rowN).Value = orderNumb
        Range("C" & rowN).Value = oDate
        Range("D" & rowN).Value = total
        Range("E" & rowN).Value = orderStatus
        Range("I" & rowN).Value = shipMethod
        Range("J" & rowN).Value = sDate
        Range("K" & rowN).Value = orderStock
    End If
    If Range("C" & rowN).Value > sDate Then
        Range("A" & rowN).EntireRow.Insert
        Range("A" & rowN).Value = company
        Range("B" & rowN).Value = orderNumb
        Range("C" & rowN).Value = oDate
        Range("D" & rowN).Value = total
        Range("E" & rowN).Value = orderStatus
        Range("I" & rowN).Value = shipMethod
        Range("J" & rowN).Value = sDate
        Range("K" & rowN).Value = orderStock
    End If
    If rowN = 10000 Then
        MsgBox ("ERROR")
        Exit Sub
    End If

    Next

    ThisWorkbook.Worksheets("ordersbyLOGdate").Activate 'start sorting data into its proper place
    rowN = 2 'start at the first row of data, a heading is placed in row 1
    Dim check As Boolean
    check = True
    Dim blankRows As Integer
    blankRows = 0
    Dim startR As Long
    Dim endR As Long
    startR = 0
    endR = 0

    Do Until blankRows = 15
        If Range("J" & rowN).Value <> "" Then
            blankRows = 0
            If check = True Then
                startR = rowN
                endR = Range("D" & rowN).End(xlDown).Row
                endR = endR - 1
                Range("D" & rowN).Formula = "=SUM(D" & startR & ":D" & endR & ")"
                check = False
            End If
            rowN = rowN + 1
        Else
            blankRows = blankRows + 1
            If check = False Then
                check = True
            End If
        End If
    Loop

    check = True
    blankRows = 0
    startR = 0
    endR = 0
    rowN = 2

    ThisWorkbook.Worksheets("ordersbySHIPdate").Activate
        Do Until blankRows = 15
        If Range("J" & rowN).Value <> "" Then
            blankRows = 0
            If check = True Then
                startR = rowN
                endR = Range("D" & rowN).End(xlDown).Row
                endR = endR - 1
                Range("D" & rowN).Formula = "=SUM(D" & startR & ":D" & endR & ")"
                check = False
            End If
            rowN = rowN + 1
        Else
            blankRows = blankRows + 1
            If check = False Then
                check = True
            End If
        End If
    Loop

    ThisWorkbook.Worksheets("by month").Activate
    MsgBox ("DONE!")

End Sub

Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function

Function firstBlankRow(ws As Worksheet) As Long
    Dim rw As Range
    For Each rw In ws.UsedRange.Rows
        If rw.Address = ws.Range(rw.Address).SpecialCells(xlCellTypeBlanks). _
            Address Then
                firstBlankRow = rw.Row
                Exit For
        End If
    Next
    If firstBlankRow = 0 Then
        firstBlankRow = ws.Cells.SpecialCells(xlCellTypeLastCell). _
                    Offset(1, 0).Row
    End If
End Function

请忽略未使用的随机变量（并非所有宏都粘贴在此处，只是我遇到问题的部分）

任何帮助都将不胜感激（当然，如果我的尝试可以改进，我非常欢迎任何提示:)）

提前致谢！

2 个答案:

答案 0 :(得分：1)

我认为最好将所有数据添加到最后一部分，然后使用以下代码对其进行排序：

ActiveWorkbook.Worksheets("ordersbyLOGdate").Activate
ActiveWorkbook.Worksheets("ordersbyLOGdate").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ordersbyLOGdate").Sort.SortFields.Add Key:=Range("C1:C" & rowN) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ordersbyLOGdate").Sort
    .SetRange Range("A1:K" & rowN)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

答案 1 :(得分：0)

正如所承诺的那样，我花了几分钟时间来完成您的代码并改进了一些内容。 

Sub Button1_Click()

    Dim colL As String, company As String, orderNumb As String
    Dim orderStatus As String, shipMethod As String, orderStock As String
    Dim countR As Long, countLoop As Long, LL As Long
    Dim startR As Long, endR As Long
    Dim oDate As Date, sDate As Date
    Dim total As Double
    Dim wb As Workbook, wsMonth As Worksheet
    Dim i As Integer, x As Integer, lastRow As Integer, rowN As Integer
    Dim check As Boolean
    Dim blankRows As Integer

    Set wb = ThisWorkbook
    Set wsMonth = wb.Worksheets("by month")
    Set wsLog = wb.Worksheets("ordersbyLOGdate")
    Set wsShip = wb.Worksheets("ordersbySHIPdate")
    countR = wsMonth.Cells(wsMonth.Rows.Count, 1).End(xlUp).Row
    countLoop = 1

    For i = 2 To countR

        company = wsMonth.Range("A" & i)
        orderNumb = Val(wsMonth.Range("B" & i))
        oDate = wsMonth.Range("C" & i)
        total = Val(wsMonth.Range("D" & i))
        orderStatus = wsMonth.Range("E" & i)
        shipMethod = wsMonth.Range("I" & Count)
        sDate = wsMonth.Range("J" & i)
        orderStock = wsMonth.Range("K" & i)

        LL = wsMonth.Range("D" & wsMonth.Rows.Count).End(xlUp).Row + 2

        rowN = 2
        lastRow = wsLog.Cells(wsLog.Rows.Count, 3).End(xlUp).Row
        Do Until wsLog.Range("C" & rowN) >= oDate
            If rowN > lastRow Then
                MsgBox "ERROR"
                Exit Sub
            End If
            rowN = rowN + 1
        Loop

        If wsLog.Range("C" & rowN) >= oDate Then

            If wsLog.Range("C" & rowN) > oDate Then
                Debug.Print "compare date is GREATER than oDate, - 1 from rowN and insert data there"
            End If

            wsLog.Rows(rowN).Insert
            wsLog.Range("A" & rowN) = company
            wsLog.Range("B" & rowN) = orderNumb
            wsLog.Range("C" & rowN) = oDate
            wsLog.Range("D" & rowN) = total
            wsLog.Range("E" & rowN) = orderStatus
            wsLog.Range("I" & rowN) = shipMethod
            wsLog.Range("J" & rowN) = sDate
            wsLog.Range("K" & rowN) = orderStock

        End If

        rowN = 2
        lastRow = wsShip.Cells(wsShip.Rows.Count, 3).End(xlUp).Row
        Do Until wsShip.Range("C" & rowN) >= sDate
            If rowN > lastRow Then
                MsgBox "ERROR"
                Exit Sub
            End If
            rowN = rowN + 1
        Loop

        If wsShip.Range("C" & rowN) >= sDate Then

            wsShip.Rows(rowN).Insert
            wsShip.Range("A" & rowN) = company
            wsShip.Range("B" & rowN) = orderNumb
            wsShip.Range("C" & rowN) = oDate
            wsShip.Range("D" & rowN) = total
            wsShip.Range("E" & rowN) = orderStatus
            wsShip.Range("I" & rowN) = shipMethod
            wsShip.Range("J" & rowN) = sDate
            wsShip.Range("K" & rowN) = orderStock

        End If

    Next

    MysteryFunk (wsLog)
    MysteryFunk (wsShip)

    wsMonth.Activate
    MsgBox ("DONE!")

End Sub

Function MysteryFunk(sheetName As Workheet)
    Dim rowN As Long, blankRows As Long, startR As Long, endR As Long
    Dim check As Boolean

    rowN = 2
    check = True
    blankRows = 0
    startR = 0
    endR = 0

    Do Until blankRows = 15
        If ws.Range("J" & rowN) <> "" Then
            blankRows = 0
            If check = True Then
                startR = rowN
                endR = ws.Range("D" & rowN).End(xlDown).Row
                endR = endR - 1
                ws.Range("D" & rowN).Formula = "=SUM(D" & startR & ":D" & endR & ")"
                check = False
            End If
            rowN = rowN + 1
        Else
            blankRows = blankRows + 1
            If check = False Then
                check = True
            End If
        End If
    Loop

End Function

Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

  1. 我使用了一些工作簿/工作表对象，以确保我们使用正确的.Range s。

  2. 我删除了＆＃34; firstBlankRow＆＃34;功能并继续使用一些可靠的内置VBA功能。

  3. 我删除了默认情况下使用的所有.Value，因为它将范围归因于变量（不使用类似Set rng = Range("...")的内容）

  4. 我修改了一些部分以允许代码重复性更低，并且仍然执行相同的操作。

  5. 我将所有Dim分组在顶部。

    6. 我不确定（现在命名的）＆＃34; MysteryFunk＆＃34;做;当它找到一些＆＃34;有效的＆＃34;空行。还不确定您对数据进行排序的位置，但如前所述，只需使用Excel .Sort函数。

相关问题
最新问题