Giúp mình tạo 2 macro này với

[tuan206791]

Mình có 2 macro cần tạo, nhờ mọi người giúp đỡ. Mình biết ít về excel mong mọi người thông cảm

 

[tuan206791]

Bận việc chút, giờ mới xong.

Tạo bảng kê:

Sub TaoDS()
Dim Tm, Tm1(), Fs As Boolean, i, j
Dim Vg As Range ', Vg1 As Range
Application.ScreenUpdating = False
Fs = True: S2.Columns("A:D").Clear
Set Vg = Range(S1.[a1], S1.[b65536].End(3))
For i = 1 To S1.[b65536].End(3).Row
If S1.Cells(i, 1) = "" And InStr(1, S1.Cells(i, 2), _
"===") = 0 And S1.Cells(i, 2) <> "" Then
j = j + 3
ReDim Preserve Tm1(1 To 4, 1 To j)
Tm1(1, j - 1) = S1.Cells(i, 2)
Fs = True
'End If
ElseIf S1.Cells(i, 1) <> "" Then
If Fs = True Then
j = j + 1
ReDim Preserve Tm1(1 To 4, 1 To j)
ReDim Preserve Tm1(1 To 4, 1 To j)
Tm1(1, j) = "'" & Format(S1.Cells(i, 1), "00000")
Tm1(2, j) = S1.Cells(i, 2)
Fs = False
Else
Tm1(3, j) = "'" & Format(S1.Cells(i, 1), "00000")
Tm1(4, j) = S1.Cells(i, 2)

Fs = True
End If
End If
Next
For i = 1 To UBound(Tm1, 2)
For j = 1 To 4
S2.Cells(i, j).Value = Tm1(j, i)
Next
With S2.Cells(i, 1).Resize(, 4)
If WorksheetFunction.CountA(.Value) = 1 Then
.Merge
.HorizontalAlignment = xlCenter
End If
End With
With S2.Cells(i, 1).Resize(, 4)
If WorksheetFunction.CountA(.Value) > 1 Then
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlInsideVertical).Weight = xlThin
End If
End With
Next
End Sub

Xoá đề mục:

Sub XoaDM()
Dim Cl As Range, Cl1 As Range
Set Cl1 = Sheet1.[a1]
Sheet1.Columns(1).Clear
For Each Cl In Range(Sheet2.[a1], Sheet2.[a65536].End(3))
If InStr(1, Cl, ".mp3") > 0 Then
Cl1.Value = Cl.Value
Set Cl1 = Cl1.Offset(1)
End If
Next
End Sub

Sao lại thế, biết đâu giúp nhau 1 chút cũng vui.

Cám ơn anh nhiều. Đã chạy rất tốt anh ạ, cái này sẽ giúp em đỡ tốn rất nhiều thời gian. Hôm qua anh tạo cho em cái này. giờ nhờ anh sửa lại cho em chút nhé http://www.giaiphapexcel.com/forum/...acro-sẽ-chạy-tiếp-khi-chuyển-sang-1-sheet-mới

 

[sealand]

Sửa ra sao bạn phải nói cụ thể chứ.

 

[tuan206791]

Sửa ra sao bạn phải nói cụ thể chứ.

Em có ghi kèm trong file

 

[tuan206791]

Sửa ra sao bạn phải nói cụ thể chứ.

Xem lại giúp em cái hồi chưa anh làm giùm bị lỗi 1 chút anh ạ. cái này mỗi khi xóa danh mục thì nó bị mất 1 ít dữ liệu anh ạ