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

我有一个input表单（“按月”），用户将数据input到某些单元格，然后将这些数据分类到两个单独的电子表格（“orderbyLOGdate”和“orderbySHIPdate”） – 你可以猜测这些电子表格包含相同的数据，他们不同（通过datedate，然后按发货date）。

我可以读取和存储数据，但是当对数据进行sorting并将其放置在电子表格中时，它并不会结束在我想要的位置，任何人都可以看到我在这里错过了什么？

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 

请忽略不使用的随机variables（不是所有的macros都粘贴在这里，只是我遇到的部分）

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

提前致谢！

Answer 1

如所承诺的，我花了几分钟的时间来完成你的代码并改进了一些东西。

 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. 我删除了“firstBlankRow”function，并继续使用一些可靠的内置VBAfunction。

3. 我删除了所有.Value因为它是默认情况下，当一个范围归属于一个variables（不使用类似于Set rng = Range("...") ）

4. 我修改了一些章节，使代码重复性较低，仍然执行相同的操作。

5. 我把所有的Dim s分组在顶部。

我不确定（现在命名的）“MysteryFunk”到底是什么; 当它find一些“有效的”空白行时似乎增加了一个部分的总和。 也不知道你的意思sorting数据，但如前所述，只需使用Excel .Sort函数。

Answer 2

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

 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