欢迎光临散文网 会员登陆 & 注册

[Mabinogi]excel读取指定角色包裹数据的VBA

2023-05-26 08:17 作者:快乐的布里尔  | 我要投稿

snowmirai前段时间更新后可以将角色包裹数据保存到本地,但是每个角色的包裹数据都是单独保存的,需要找东西要逐个打开比较笨重。所以花了一下午时间看了下VBA,写了个可以读取选定角色包裹(单选多选均可)的功能。保存模块之后在工作表添加一个按钮用于加载脚本就行了。

EXCEL VBA个人感觉是难懂还难用。。。

Sub Import_Item_TXT()

    ActiveSheet.Unprotect Password:="mabinogi"

    

    Dim objStream, StrData, Arr1, i As Long

    

    'Dim rows_num

    

    Dim full_info As String

    Dim string_searchResult

    

    Dim item_name As String, item_other As String, item_id As String

    Dim item_id_key As String, item_otherinfo_key As String

    

    Dim pathX As String, item_Code As String, N As Long

    

    Dim String_reading As String

    String_reading = "已导入文本"

    

    Dim pathCollection As String

    

    With Application.FileDialog(msoFileDialogFilePicker)

        '////////////////打开文件/////////////

        With .Filters

            .Clear

            .Add "txt_File", "*.txt"

        End With

        .AllowMultiSelect = True

        .Show

        '/////////////////////////////////////

        

        '////////////////清除原有数据////////////

        ActiveSheet.UsedRange.ClearContents

        ActiveSheet.Cells.Interior.Pattern = xlNone

        '////////////////////////////////////////

        

        N = 3

        'rows_num = 1

        

        For lngcount = 1 To .SelectedItems.Count

            j = 1

            Set objStream = CreateObject("ADODB.Stream")

            objStream.Charset = "utf-16"

            objStream.Open

            objStream.LoadFromFile (.SelectedItems(lngcount))

            StrData = objStream.readtext()

            

            Arr1 = Split(StrData, vbCrLf)

            objStream.Close

            Set objStream = Nothing

            

            ActiveSheet.Rows(N).Interior.Color = 65535

            Range("D" & N) = .SelectedItems(lngcount)

            For i = 0 To UBound(Arr1)

                string_searchResult = 0

                full_info = Arr1(i)

                '////////////////截取字符串////////////

                '  item_id_key  , item_otherinfo_key

                item_id_key = "ClassID"

                item_otherinfo_key = "Color"

                '//////////////////////////////////////


                '////////////////查找字符串///////////

                If (InStr(full_info, item_id_key)) Then

                    string_searchResult = 1

                End If

                '///////////////////////////////////

                If full_info <> "" Then

                    If (string_searchResult) Then

                       item_name = Mid(full_info, 10, InStr(full_info, item_id_key) - 11)

                       item_other = Mid(full_info, InStr(full_info, item_otherinfo_key) - 1)

                       item_id = Mid(full_info, InStr(full_info, item_id_key) - 1, Len(Mid(full_info, InStr(full_info, item_id_key) - 1)) - Len(item_other))                  

                       Range("B" & N) = item_name

                       Range("C" & N) = item_id

                       Range("D" & N) = item_other

                    Else

                       Range("A" & N) = full_info

                   End If

                End If

                N = N + 1

                string_searchFault = 0

            Next

        Next lngcount

        'MsgBox String_reading

    End With

    ActiveSheet.Protect Password:="mabinogi"

 End Sub


[Mabinogi]excel读取指定角色包裹数据的VBA的评论 (共 条)

分享到微博请遵守国家法律