นี่คือ VBA หรือแมโครที่คุณสามารถเรียกใช้บนแผ่นงานของคุณ คุณต้องกดalt+ F11เพื่อแสดงพร้อมท์ Visual Basic สำหรับแอปพลิเคชันไปที่สมุดงานของคุณright click - insert - moduleและวางรหัสนี้ในนั้น จากนั้นคุณสามารถเรียกใช้โมดูลจากภายใน VBA F5โดยการกด มาโครนี้ชื่อ "ทดสอบ"
Sub test()
'define variables
Dim RowNum as long, LastRow As long
'turn off screen updating
Application.ScreenUpdating = False
'start below titles and make full selection of data
RowNum = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A2", Cells(LastRow, 4)).Select
'For loop for all rows in selection with cells
For Each Row In Selection
With Cells
'if customer name matches
If Cells(RowNum, 1) = Cells(RowNum + 1, 1) Then
'and if customer year matches
If Cells(RowNum, 4) = Cells(RowNum + 1, 4) Then
'move attribute 2 up next to attribute 1 and delete empty line
Cells(RowNum + 1, 3).Copy Destination:=Cells(RowNum, 3)
Rows(RowNum + 1).EntireRow.Delete
End If
End If
End With
'increase rownum for next test
RowNum = RowNum + 1
Next Row
'turn on screen updating
Application.ScreenUpdating = True
End Sub
สิ่งนี้จะทำงานผ่านสเปรดชีตที่เรียงลำดับและรวมแถวที่ต่อเนื่องกันซึ่งตรงกับลูกค้าและปีและลบแถวที่ว่างในขณะนี้ สเปรดชีตจะต้องเรียงแบบที่คุณได้นำเสนอลูกค้าและปีจากน้อยไปมากแมโครนี้โดยเฉพาะอย่างยิ่งจะไม่ดูเกินแถวติดต่อกัน
แก้ไข - เป็นไปได้ทั้งหมดที่ฉันwith statementไม่มีความจำเป็นอย่างสมบูรณ์ แต่ก็ไม่ได้ทำร้ายใคร ..
ปรับปรุงแล้ว 02/28/14
มีคนใช้คำตอบนี้ในคำถามอื่นและเมื่อฉันกลับไปฉันคิดว่า VBA นี้แย่ ฉันได้ทำมันใหม่ -
Sub CombineRowsRevisited()
Dim c As Range
Dim i As Integer
For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
If c = c.Offset(1) And c.Offset(,4) = c.Offset(1,4) Then
c.Offset(,3) = c.Offset(1,3)
c.Offset(1).EntireRow.Delete
End If
Next
End Sub
เยี่ยมชม 05/04/16
ถามอีกครั้งวิธีการรวมค่าจากหลายแถวเป็นแถวเดียว? มีโมดูล แต่ต้องการตัวแปรอธิบายและอีกครั้งมันแย่มาก
Sub CombineRowsRevisitedAgain()
Dim myCell As Range
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For Each myCell In Range(Cells("A2"), Cells(lastRow, 1))
If (myCell = myCell.Offset(1)) And (myCell.Offset(0, 4) = myCell.Offset(1, 4)) Then
myCell.Offset(0, 3) = myCell.Offset(1, 3)
myCell.Offset(1).EntireRow.Delete
End If
Next
End Sub
อย่างไรก็ตามขึ้นอยู่กับปัญหามันอาจจะดีกว่าที่จะstep -1อยู่บนหมายเลขแถวจึงไม่มีอะไรถูกข้ามไป
Sub CombineRowsRevisitedStep()
Dim currentRow As Long
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For currentRow = lastRow To 2 Step -1
If Cells(currentRow, 1) = Cells(currentRow - 1, 1) And _
Cells(currentRow, 4) = Cells(currentRow - 1, 4) Then
Cells(currentRow - 1, 3) = Cells(currentRow, 3)
Rows(currentRow).EntireRow.Delete
End If
Next
End Sub
