根据2条标准合并2个单元格+select最早和最新的dateVBA

我是VBA的新手,想学习它,并让我的文件工作。 所以,如果有人能帮我用我的代码,这将是非常好的,如果你可以简单地解释一行代码,这将是非常好的。

我的问题:我有约5000个产品的需求历史。

在这里输入图像说明

Articlecode:60012

date:19-4-2014

需求:-1


我想要做的是以下几点:

  1. 如果是两行并求和:
    • 文章代码是相同的
    • date是一样的

检查条件并复制一整行工程。 我的代码:

Sub AddDuplicateDates() 'Define variables lastrow Dim i, Lastrow Lastrow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row 'Loop trough data and combine if date is the same For i = 2 To Lastrow If Sheets("Data").Cells(i, "A").Value = Sheets("Data").Cells(i - 1, "A").Value Then If Sheets("Data").Cells(i, "B").Value = Sheets("Data").Cells(i - 1, "B").Value Then 'Here I would like to copy cell Sheet("Data").Cells(i, "C") and add this 'to Sheet("Datacorrected").Cells(i,"C") thus offset(0). How does this work? Else Sheets("Data").Cells(i, "A").EntireRow.Copy Destination:=Sheets("DataCorrected").Range("A" & Rows.Count).End(xlUp).Offset(1) End If End If Next i End Sub 
  1. select最新和最早的date
    • 我已经设法select唯一的值(文章代码)不同的工作表:工作表(结果)
    • 我已经find了一些主题,但不幸的是,所有这些都在同一张工作表上操作,没有符合条件(条款代码)。 例如: vba,excel:返回此string数组中最早的date值 。 问题是,我是新的VBA,不明白所有的代码,所以我不知道它是如何工作的,所以我可以把它翻译成我的问题。 有人可以帮我解决这个问题,或者指出我能find一个清晰的解释吗?

此代码位于命令button的单击事件中。 如果需要,您可以将其更改为其他子版本。

在你的VBA IDE进入工具菜单并select参考。 select“Microstoft ActiveX数据对象2.8库”。

这假设你的第一个列表在表1中。它将数据写入表2。

 Private Sub CommandButton1_Click() Dim dEarliest As Date Dim dLatest As Date Dim lLastCode As Long Dim ws1 As Excel.Worksheet Dim ws2 As Excel.Worksheet Set ws1 = ActiveWorkbook.Sheets("Sheet1") Set ws2 = ActiveWorkbook.Sheets("Sheet2") Dim rs As New ADODB.Recordset Dim lRow As Long 'Add fields to your recordset for storing data. You can store sums here. With rs .Fields.Append "Articlecode", adBigInt .Fields.Append "Date", adDate .Fields.Append "Demand", adInteger .Open End With lRow = 1 ws1.Activate 'Loop through and record what is in the columns Do While lRow <= ws1.UsedRange.Rows.count 'Filter to see if we already have this Articlecode and date rs.Filter = "" rs.Filter = "Articlecode=" & Trim(str(ws1.Range("A" & lRow).Value)) & " AND Date='" & Trim(str(ws1.Range("B" & lRow).Value)) & "'" If rs.RecordCount = 1 Then 'If we find that we already have this record, add the demand to the current record. rs.Fields("Demand").Value = rs.Fields("Demand").Value + ws1.Range("C" & lRow).Value rs.Update Else 'If we don't have this # and date, create a new record. rs.AddNew rs.Fields("Articlecode").Value = ws1.Range("A" & lRow).Value rs.Fields("Date").Value = ws1.Range("B" & lRow).Value rs.Fields("Demand").Value = ws1.Range("C" & lRow).Value rs.Update End If lRow = lRow + 1 ws1.Range("A" & lRow).Activate Loop rs.Filter = "" rs.Sort = "Articlecode, Date" ws2.Activate lRow = 1 'Here we loop through the data we collected and write it out. Do While rs.EOF = False ws2.Range("A" & lRow).Value = rs.Fields("Articlecode").Value ws2.Range("B" & lRow).Value = Format(rs.Fields("Date").Value, "mm/dd/yyyy") ws2.Range("C" & lRow).Value = rs.Fields("Demand").Value lRow = lRow + 1 rs.MoveNext Loop 'Now let's find the earliest and latest dates for each Articlecode ws2.Range("E1").Value = "Articlecode" ws2.Range("F1").Value = "Earliest" ws2.Range("G1").Value = "Latest" lRow = 1 rs.MoveFirst Do While rs.EOF = False If rs.Fields("Articlecode").Value <> lLastCode Then 'The first time we have an Articlecode we will write a line for it. lRow = lRow + 1 ws2.Range("E" & lRow).Value = rs.Fields("Articlecode").Value ws2.Range("F" & lRow).Value = Format(rs.Fields("Date").Value, "mm/dd/yyyy") ws2.Range("G" & lRow).Value = Format(rs.Fields("Date").Value, "mm/dd/yyyy") Else 'For other occurrences of this Articlecode we will just evaluate the dates. If rs.Fields("Date").Value < ws2.Range("F" & lRow).Value Then ws2.Range("F" & lRow).Value = Format(rs.Fields("Date").Value, "mm/dd/yyyy") End If If rs.Fields("Date").Value > ws2.Range("G" & lRow).Value Then ws2.Range("G" & lRow).Value = Format(rs.Fields("Date").Value, "mm/dd/yyyy") End If End If 'Record the this articlecode lLastCode = rs.Fields("Articlecode").Value rs.MoveNext Loop End Sub 

这是否必须在VBA中完成? 或者使用数据透视表来报告数据是否符合要求? 代码并不总是答案…

在这里输入图像说明