xin chỉ giáo macro tìm nội dung giống nhau trong word chuyển thành excel

[Bo Cong Anh old]

#xin các bác chỉ giáo macro nào trong excel hoặc word để xử lý tình huống này với
Làm thế nào để lấy được dãy số phía sau CertifiedCode và chuyển thành 1 cột ở file excel ạ
Ví dụ trong trường hợp "CertifiedCode":"55E8006844" là lấy 55E8006844

 

[BuiQuangThuan]

#xin các bác chỉ giáo macro nào trong excel hoặc word để xử lý tình huống này với
Làm thế nào để lấy được dãy số phía sau CertifiedCode và chuyển thành 1 cột ở file excel ạ
Ví dụ trong trường hợp "CertifiedCode":"55E8006844" là lấy 55E8006844

Kết quả trả về excel như thế nào?

 

[VetMini]

Tiếng Việt là chỉ dẫn. Chỉ giáo là tiếng Tầu, dùng với người lạ có khả năng bị hiểu là châm biếm.

 

[Bo Cong Anh old]

Kết quả trả về excel như thế nào?

Chỉ cần 1 cột chứa các mã đó là đc

 

[batman1]

Tên tập tin Excel là gì, cả 2 tập tin ở cùng thư mục hay gì?

 

[Bo Cong Anh old]

Tên tập tin Excel là gì, cả 2 tập tin ở cùng thư mục hay gì?

Tên nào cũng đc, cả hai tập tin ở cùng thư mục đi ạ

 

[batman1]

Code sau ta đặt trong tập tin Word - data.docx (Alt + F11 -> menu Insert -> Module -> dán code vào Module -> lưu với tên data.docm)

Trong code tôi coi tên là "hic hic.xlsx". Tự sửa lại.

Cách 1. Cho nội dung Word vào chuỗi text rồi dùng biểu thức chính quy.

Sub lay_so_reg()
Dim k As Long, text As String, ExcelFile As String, result(), re As Object, matches As Object, match As Object, ExcelApp As Object
    text = ThisDocument.Content.text
    Set re = CreateObject("VBScript.RegExp")
    With re
        .IgnoreCase = True
        .Global = True
        .Pattern = """CertifiedCode"":""(.+?)"""
    End With
    Set matches = re.Execute(text)
    If matches.Count Then
        ReDim result(1 To matches.Count, 1 To 1)
        For Each match In matches
            k = k + 1
            result(k, 1) = match.SubMatches(0)
        Next match
        ExcelFile = ThisDocument.Path & "\hic hic.xlsx"
        Set ExcelApp = CreateObject("Excel.Application")
        ExcelApp.Visible = True
        With ExcelApp.Workbooks.Open(ExcelFile)
            .Worksheets(1).Range("A1").Resize(UBound(result, 1)).Value = result
        End With
    End If
    Set re = Nothing
End Sub

Cũng có thể sau khi có text thì dùng VBA.Instr

Cách 2. Dùng phương thức FIND của đối tượng Selection

Sub lay_so_find()
Dim k As Long, text As String, ExcelFile As String, result(), ExcelApp As Object
    ReDim result(1 To 1000, 1 To 1)
    Application.Selection.Start = 0
    With Application.Selection.Find
        .ClearFormatting
        .text = """CertifiedCode"":""*"""
        .MatchWildcards = True
        Do While .Execute
            k = k + 1
            text = Application.Selection.text
            text = Mid(text, InStr(1, text, ":") + 2)
            result(k, 1) = Left(text, Len(text) - 1)
        Loop
    End With
    If k Then
        ExcelFile = ThisDocument.Path & "\hic hic.xlsx"
        Set ExcelApp = CreateObject("Excel.Application")
        ExcelApp.Visible = True
        With ExcelApp.Workbooks.Open(ExcelFile)
            .Worksheets(1).Range("A1").Resize(k).Value = result
        End With
    End If
End Sub

 

[Bo Cong Anh old]

Sub lay_so_find() Dim k As Long, text As String, ExcelFile As String, result(), ExcelApp As Object ReDim result(1 To 1000, 1 To 1) Application.Selection.Start = 0 With Application.Selection.Find .ClearFormatting .text = """CertifiedCode""*""" .MatchWildcards = True Do While .Execute k = k + 1 text = Application.Selection.text text = Mid(text, InStr(1, text, ":") + 2) result(k, 1) = Left(text, Len(text) - 1) Loop End With If k Then ExcelFile = ThisDocument.Path & "\hic hic.xlsx" Set ExcelApp = CreateObject("Excel.Application") ExcelApp.Visible = True With ExcelApp.Workbooks.Open(ExcelFile) .Worksheets(1).Range("A1").Resize(k).Value = result End With End If End Sub

chân thành cám ơn pro hihi