Wiki: Excel

Code dành riêng cho excel trên máy tính

Gộp nhiều sheet thành 1 sheet

Các sheet form giống nhau + copy code xong + ấn F5 >>File Tổng hợp tự tạo

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

Cách gộp nhiều ô thành 1 trên Excel không mất dữ liệu

Bôi đen nhiều ô + ấn Alt + F8, hoặc Alt + Fn + F8

Dim Cll As Range, Temp As String
On Error Resume Next
If Selection.MergeCells = False Then
For Each Cll In Selection
If Cll <> "" Then Temp = Temp + Cll.Text + " "
Next Cll
Selection.Merge
Selection.Value = Left(Temp, Len(Temp) - 1)
Else
Selection.UnMerge
End If
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter

Hàm nối các dữ liệu theo cột hoặc hàng

Nối cột = GPE($A$2:$D$15,ROWS($1:1))
Nối hàng = GPE2(A2:D2)
Ghi chú: AD là vùng chứa dữ liệu. Đặt Hàm xong kéo xuống theo thứ tự để nhận kết quả

Option Explicit

Public Function GPE(Rng As Range, N As Long) As Variant
On Error Resume Next
Dim sArr(), dArr(), I As Long, J As Long, K As Long
sArr = Rng.Value
ReDim dArr(1 To UBound(sArr, 1) * UBound(sArr, 2), 1 To 1)
For J = 1 To UBound(sArr, 2)
    For I = 1 To UBound(sArr, 1)
        If sArr(I, J) <> "" Then
            K = K + 1
            dArr(K, 1) = sArr(I, J)
        End If
    Next I
Next J
If K >= N Then
    GPE = dArr(N, 1)
Else
    GPE = ""
End If
End Function

Public Function GPE2(Rng As Range) As String
Dim Cll As Range
For Each Cll In Rng
    GPE2 = GPE2 & Cll.Value
Next
End Function

Tài khoản giaiphapexcel.com

buxul@utooemail.com
Quanmatkhau

Lọc dữ liệu nhanh không cần Data Validation Dropdown

Phải chuột Pick from Drop-drop down list (Phím tắt K)

Chuyển số thành bằng chữ

Public Function ReadNumToUnicode(conso) As String
s09 = Array("", " m" & ChrW(7897) & "t", " hai", " ba", " b" & ChrW(7889) & "n", " n" & ChrW(259) & "m", " s" & ChrW(225) & "u", " b" & ChrW(7843) & "y", " t" & ChrW(225) & "m", " ch" & ChrW(237) & "n")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(conso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = ChrW(226) & "m " Else dau = "" conso = Application.WorksheetFunction.Round(Abs(conso), 0) conso = " " & conso conso = Replace(conso, ",", "", 1) vt = InStr(1, conso, "E") If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
Docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If Docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
Else
If n1 = 0 Then
If Docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
Else
s1 = s09(n1) & " tr" & ChrW(259) & "m"
End If
If n2 = 0 Then
If s1 = "" Or n3 = 0 Then
s2 = ""
Else
s2 = " linh"
End If
Else
If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " l" & ChrW(259) & "m"
Else
s3 = s09(n3)
End If
If i > Len(conso) Then
s123 = s1 & s2 & s3
Else
s123 = s1 & s2 & s3 & lop3(lop)
End If
End If
lop = lop + 1
If lop > 3 Then lop = 1
Docso = Docso & s123
If i > Len(conso) Then Exit Do
Loop
If Docso = "" Then ReadNumToUnicode = "kh" & ChrW(244) & "ng" Else ReadNumToUnicode = dau & Trim(Docso)
Else
ReadNumToUnicode = conso
End If
End Function

Gộp các sheet thành 1 sheet Tổng

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

Xóa xuống dòng

=TRIM(SUBSTITUTE(A1;CHAR(10);" "))






Sản phẩm