VBAG01 - Tuyệt đỉnh VBA - Viết code trong tầm tay

Chào bạn bạn vui lòng dẩy file lên nhé, code không có dữ liệu không thể biết được đang bị lỗi ở đâu nhé.

Thầy ơi e sai ở đâu mà e ấn bỏ trùng nó ko chạy

Sub Macro2()
'
' Macro2 Macro
'

'
    Range("A1:A20").Select
    ActiveSheet.Range("$A$1:$A$8").RemoveDuplicates Columns:=1, Header:=xlYes
    ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 147, 19.2, 118.2, 49.8). _
        Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "b? trùng"
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 8). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignLeft
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(3, 6).Font
        .BaselineOffset = 0
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
    Selection.OnAction = "Macro2"
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "Tp HCM"
    Range("A9").Select
    ActiveCell.FormulaR1C1 = "Qu?ng Ninh"
    Range("A10").Select
    ActiveCell.FormulaR1C1 = "Hu?"
    Range("A2:A13").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
    Selection.OnAction = "Macro2"
    Range("A2:A11").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
    Selection.OnAction = "Macro2"
    Range("A2").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
    Range("A2:A12").Select
End Sub

Cam on thay

Ví dụ mình có 1 đoạn giá trị (string) được lấy từ inputbox có tiếng Việt, thầy cho mình xin 1 hàm để msgbox hiện ra câu đó có Tiếng Việt được ko ạ, mình đã copy về và làm và nó vẫn chưa hiện ra tiếng Việt

Chào bạn với msgbox tiếng việt bạn cần thêm API để hiện thị mình sẽ cung cấp đoạn này sau nhé.

cam on thay

Chào bạn bạn xem đoạn code sau nhé.

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal Hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#Else
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function MessageBoxW Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#End If

'nguồn sưu tầm
Function MsgBoxUni(ByVal PromptUni As Variant, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal TitleUni As Variant = vbNullString) As VbMsgBoxResult
   Dim BStrMsg, BStrTitle
   BStrMsg = StrConv(PromptUni, vbUnicode)
   BStrTitle = StrConv(TitleUni, vbUnicode)
   MsgBoxUni = MessageBoxW(GetActiveWindow, BStrMsg, BStrTitle, Buttons)
End Function
Sub goidulieu()
    Dim s As String
    s = "Công ty TNHH Công Ngh" & ChrW(7879) & " Giáo D" & ChrW(7909) & "c Gitiho Vi" & ChrW(7879) & "t Nam"
    MsgBoxUni s
End Sub
Function UniVba(TxtUni As String) As String 'chuyen vba sang uni
Dim N, uni1 As String, uni2 As String
    If TxtUni = "" Then
        UniVba = """"""
    Else
        TxtUni = TxtUni & " "
        If AscW(Left(TxtUni, 1)) < 256 Then UniVba = """"
            For N = 1 To Len(TxtUni) - 1
                uni1 = Mid(TxtUni, N, 1)
                uni2 = AscW(Mid(TxtUni, N + 1, 1))
                 If AscW(uni1) > 255 And uni2 > 255 Then
                    UniVba = UniVba & "ChrW(" & AscW(uni1) & ") & "
                 ElseIf AscW(uni1) > 255 And uni2 < 256 Then
                    UniVba = UniVba & "ChrW(" & AscW(uni1) & ") & """
                 ElseIf AscW(uni1) < 256 And uni2 > 255 Then
                    UniVba = UniVba & uni1 & """ & "
                 Else
                    UniVba = UniVba & uni1
                End If
            Next
        If Right(UniVba, 4) = " & """ Then
            UniVba = Mid(UniVba, 1, Len(UniVba) - 4)
        Else
            UniVba = UniVba & """"
        End If
    End If
End Function

mình đã dán đoạn code đó vào 1 file excel (*.xlsm) mới nhưng khi chạy  nó báo lỗi.

Cái đoạn code này:

#If VBA7 Then
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal Hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#Else
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function MessageBoxW Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#End If

Dán vô đâu thầy ơi

Ý mình muốn là chương trình nó ra 1 bảng thông báo nhập vô 1 câu tiếng Việt và msgbox hiện ra đúng câu Tiêng Việt đó

Chào bạn vậy bạn có thể tham khảo ví dụ sau nhé:

https://drive.google.com/file/d/1CB7V...

Mình đã tải về và chạy thử 

Sub Test2()

    Dim MsgText As String, tieude As String

    Dim Name As Variant

    MsgText = UniConvert("Nhaapj teen vafo ddaay :")

    tieude = UniConvert("Dieenx ddanf tuhocvba chafo cacs banj")

    Name = Application.InputBox(Prompt:=MsgText, Title:=tieude, Default:="Nguyen Van A", Type:=2)  'Type:=2 la kieu ky tu Text

    If VarType(Name) = 11 Then Exit Sub 'Nguoi dung an vao nut Cancel

    'Cac ban tham khao them o day:

    ' https://tuhocvba.net/threads/cung-tim...

    MsgBox Name

  End Sub

Chào bạn bạn để msgboxuni.. nó sẽ chạy bạn nhé.

Chào bạn bạn đẩy file lên nhé.

https://docs.google.com/spreadsheets/...

Em gửi thầy ạ. Thầy xem giùm ạ

Hi thầy Tuấn Ba, như đoạn code của thầy đưa phía trên, thì thầy có thể giải thích giúp e chỗ này được không ah?

Sau khi End If tức là đã thực thi được code lấy được dữ liệu vào file tổng hợp rồi
thì đoạn tiếp theo này có ý nghĩa để làm gì ah?
wb_KQ.Sheets(2).Range("D1").Value = WorksheetFunction.CountIfs(wb_KQ.Sheets(2).Range("A6:A" & dongcuoi_wb), 1)

Chào bạn phần code có thể mình ghi thừa vào trong đó rồi.