Đã nhờ mà còn nói thế.Hi các Pro,
Có ai vui lòng giúp đoạn macro để xử lý dữ liệu theo yêu cầu trong File đính kèm không?
Xin Cảm ơn trước, cái này mình thấy dễ ẹc à, nhưng mà chưa biết làm. Giúp mình nhé.
Sub NoiDG()
'With Application
' .DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationManual
'End With
Dim SoRow, MyRng, iR, jR, eRow, iRow, MyStr As String
Set WF = WorksheetFunction
Sheet1.Select
With Sheet1
eRow = .Cells(10000, 2).End(xlUp).Row
Set MyRng = .Range(.Cells(1, 2), .Cells(eRow, 2))
SoRow = MyRng.Count
End With
MyStr = ""
For iR = SoRow To 2 Step -1
If Left(MyRng(iR), 1) <> "+" Then
eRow = iR
Exit For
End If
Next
Set MyRng = Range(Cells(1, 2), Cells(eRow, 2))
SoRow = MyRng.Count
For iR = SoRow To 2 Step -1
If Left(MyRng(iR), 1) = "+" Then
MyStr = MyStr & MyRng(iR)
MyRng(iR).Delete Shift:=xlUp
Else
MyRng(iR) = MyRng(iR) & MyStr
MyStr = ""
End If
Next
End Sub
hic mình không biết sài làm sao với các Code này.
Trước đây tôi có đăng lên diển đàn 2 hàm: Unique và JoinIf ... Giờ chỉ việc áp dụng vào là được:Hi các Pro,
Có ai vui lòng giúp đoạn macro để xử lý dữ liệu theo yêu cầu trong File đính kèm không?
Xin Cảm ơn trước! Giúp mình nhé.
Function Unique(Vung As Range, STT As Long) As Variant
Dim i, K As Long
Dim Temp As Variant
For i = 1 To Vung.Cells.Count
If Vung(i) <> "" Then
If i = Application.WorksheetFunction.Match(Vung(i), Vung, 0) Then
K = K + 1
End If
If K = STT Then Temp = Vung(i): Exit For
End If
Next i
Unique = Temp
End FunctionFunction JoinIf(VungDK As Range, DK As Variant, VungKQ As Range, Optional PC As Variant) As String
Dim i, Dem As Long
Dim Temp As String
Dem = VungDK.Count
If IsMissing(PC) Then PC = ""
For i = 1 To Dem
If VungDK(i) = DK Then Temp = Temp & PC & VungKQ(i)
Next
JoinIf = Mid(Temp, Len(PC) + 1, Len(Temp))
End FunctionKéo fill xuống đến khi nào gặp kết quả = rổng thì dừng lại
Code của bác để nguyên báo lỗi. Em sửa chút như sau
'With Application
' .DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationManual
End WithFor iR = SoRow To 2 Step -1
If Left(MyRng(iR), 1) <> "+" Then
eRow = iR
Exit For
End If
Next............
MyRng(iR).EntireRow.Delete Shift:=xlUp
.........Sub NoiDG()
With Application
.DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationManual
End With
Dim SoRow, MyRng, iR, jR, eRow, iRow, MyStr As String
Set WF = WorksheetFunction
Sheet1.Select
With Sheet1
eRow = .Cells(10000, 2).End(xlUp).Row
Set MyRng = .Range(.Cells(1, 2), .Cells(eRow, 2))
SoRow = MyRng.Count
End With
MyStr = ""
Set MyRng = Range(Cells(1, 2), Cells(eRow, 2))
SoRow = MyRng.Count
For iR = SoRow To 2 Step -1
If Left(MyRng(iR), 1) = "+" Then
MyStr = MyStr & MyRng(iR)
MyRng(iR).EntireRow.Delete Shift:=xlUp
Else
MyRng(iR) = MyRng(iR) & MyStr
MyStr = ""
End If
Next
End SubIf Left(MyRng(SoRow), 1)= "+" then
For iR = SoRow To 2 Step -1
If Left(MyRng(iR), 1) <> "+" Then
eRow = iR
Exit For
End If
Next
end ifCác đơn giãn nhất là bạn chuyển Function JoinIf thành 1 Add-in, từ đây thì toàn bộ file trên máy bạn đều có thể dùng được như 1 hàm Excel thông thường
Sub GhepChuoi()
Dim sFind As String, r As Long, rd As Long, rc As Long
rd = 3
rc = Cells(1, 2).End(xlDown).Row
sFind = Cells(3, 1)
Do
r = Range(Cells(rd, 1), Cells(rc, 1)).Find(What:=sFind, After:=Cells(rd, 1), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
:=True, SearchFormat:=False).Row
If r = rd Then
rd = rd + 1
sFind = Cells(rd, 1)
Else
Stop
Cells(rd, 2) = Cells(rd, 2) & Cells(r, 2)
Cells(r, 1).EntireRow.Delete
rc = rc - 1
End If
Loop While rd < rc
End Sub
Không biết ai khác thì sao chứ còn tôi thì:
Oh... hô... Đó là tôi nói theo quan điểm của tôi thôi...
