Đọc rồi mà vẫn chưa hiểu lắm. Giải thích cụ thể hơn được không?
Giá như bắt đầu bằng câu chào và kết thúc bằng cảm ơn thì bài này có lẽ xong rồi.
Hihi.Anh đợt này bắt đầu có tuổi rồi ấy. Khó tính ghê ấy
Mình vẫn nhớ bài: Chim gặp bác Chào mào, chào bác.
Dạ em muốn được kết quả như cột B:C nhưng chưa biết viết code thế nào..anh biết giúp em với ạ em cám ơn
Anh nói vậy tội em quá ạ, la do em gấp nên viết không để ý ạ, anh giúp em được em cám ơn không hết chứ ạ
1. Đọc M1:N50 vào một mảng mang
Bạn đến nhà ai mà lý do gấp quá nên không chào thì họ có tiếp bạn không.
Vậy thì lần sau họ mới tiếp thôi vì chẳng có lý do gì cản trở bạn rút kinh nghiệm ngay từ lần này.
Dạ vậy em xin viết lại đăng lại anh vào giúp em nhé, xem như đó là lần sau:
Bắt đầu có những lời khuyên giúp bạn rồi đó.
Bạn nên làm theo lời khuyên ở bài #12 đi đã, mình thấy lời khuyên đó trùng với ý tưởng của mình nên không nhắc lại nữa.
Option Explicit
Sub dan_DL()
Dim lastRow As Long, r As Long, k As Long, start As Long, text As String, chucai_hienhanh As String, cotAC(), kq()
With ThisWorkbook.Worksheets("Sheet1")
.Range("B1:C" & .Range("B" & Rows.Count).End(xlUp).Row).ClearContents ' xoa ket qua cu
lastRow = .Range("M" & Rows.Count).End(xlUp).Row
If lastRow = 1 And .Range("M1").Value = "" Then Exit Sub ' neu khong co du lieu cot M thi nghi choi
kq = .Range("M1:N" & lastRow).Value
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
If lastRow = 1 And .Range("A1").Value = "" Then Exit Sub ' neu cot A khong co du lieu thi don do choi
cotAC = .Range("A1:C" & lastRow + 1).Value ' lay du 1 dong cuoi, lay 3 cot A:C
End With
cotAC(UBound(cotAC, 1), 1) = "Ngay mai em di" ' nhap chu bat ky vao cuoi mang cotAC de danh dau dong ket thuc cua du lieu cuoi cung trng cot A
For r = 1 To UBound(cotAC, 1)
text = cotAC(r, 1)
If text <> chucai_hienhanh Then
If chucai_hienhanh <> "" Then
For k = 1 To r - start ' ghi cac dong tu start toi (r-1)
cotAC(start - 1 + k, 2) = kq(k, 1) ' ghi cot M vao cot B
cotAC(start - 1 + k, 3) = kq(k, 2) ' ghi cot N vao cot C
Next k
End If
start = r
chucai_hienhanh = text
End If
Next r
ThisWorkbook.Worksheets("Sheet1").Range("A1:C" & lastRow).Value = cotAC
End Sub
Option Explicit
Sub dan_DL()
Range("B1:C1000000").ClearContents
Range("A1:C" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Formula = _
"=INDEX(M$1:M$50,COUNTIF($A$1:$A1,$A1))"
End SubGóp vui
Sub ABC()
Dim arr(), arr2(), res$(), sRow&, sRow2&, i&, k&, tmp
With ThisWorkbook.Worksheets("Sheet1")
If .Range("A1").Value = Empty Then Exit Sub
.Range("B1", .Range("C" & Rows.Count).End(xlUp)).ClearContents
arr = .Range("M1", .Range("N" & Rows.Count).End(xlUp)).Value
arr2 = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value
sRow = UBound(arr): sRow2 = UBound(arr2)
ReDim res(1 To sRow2, 1 To 2)
For i = 1 To sRow2
If tmp <> arr2(i, 1) Then k = 0: tmp = arr2(i, 1)
k = k + 1
res(i, 1) = arr(k, 1)
res(i, 2) = arr(k, 2)
Next i
.Range("B1").Resize(sRow2, 2) = res
End With
End SubSub ABC()
Dim Rng As Range, i&, iR&
Application.ScreenUpdating = False
Set Rng = Sheet1.Range("M1:N51")
With Sheet1
iR = .Range("A" & Rows.Count).End(3).Row
For i = 1 To iR
If Application.WorksheetFunction.CountIf(.Range("A1:A" & i), .Range("A" & i)) = 1 Then
Rng.Copy
.Range("D" & i).PasteSpecial xlPasteValues
End If
Next
.Range("D" & iR + 1).Resize(1000, 2).ClearContents
End With
Application.ScreenUpdating = True
End Sub
