Board logo

標題: 符合條件, 刪除多行 [打印本頁]
作者: yc1031    時間: 2015-9-3 09:14     標題: 符合條件, 刪除多行

各位好

我想請教各位刪除多行的VBA該怎麼寫才好
刪除的規格是只要在 lang "Traditional Chinese" 上方的, 至數字欄, 都是要刪除的, 例如下方3種範列, 第一個範列是 共有3行, 1, 數字 2, 英文描述 3. lang "Traditional Chinese"
我有先找到網路有人的教學, 但都是以刪除單行為主, 不曉得我這樣的規則是否可以寫的出來?

description                               
        1 item_generation_cannot_change_prefixes                       
        1                       
                # "Prefixes Cannot Be Changed"               
        lang "Traditional Chinese"                       
        1                       
                # "▽ 前綴無法被變更"               
        lang "Thai"                       
        1                       
                # "ไม่สามารถเปลี่ยน Prefix ได้"               
        lang "Russian"                       
        1                       
                # "Префиксы нельзя изменить"               


---------------------------------------------
description               
        1 local_display_socketed_gems_have_mana_reservation_+%       
        2       
                1|# "Socketed Gems have %1%%% increased Mana Reservation"
                #|-1 "Socketed Gems have %1%%% reduced Mana Reservation" negate 1
        lang "Traditional Chinese"       
        2       
                1|# "此物品上的寶石增加 %1%%% 魔力保留"
                #|-1 "此物品上的寶石減少 %1%%% 魔力保留" negate 1
        lang "Thai"       
        2       
                1|# "เจ็มที่ใส่มีการสำรองมานาเพิ่มขึ้น %1%%%"
                #|-1 "เจ็มที่ใส่มีการสำรองมานาลดลง %1%%%" negate 1
        lang "Russian"       
        2       
                1|# "Размещенные камни имеют %1%%% увеличение объема удержанной маны"
                #|-1 "Размещенные камни имеют %1%%% уменьшение объема удержанной маны" negate 1

-----------------------------------------------------------------------------------------------
description               
        1 local_physical_damage_+%       
        3       
            #|-100 "No Physical Damage"       
            1|# "%1%%% increased Physical Damage"       
            -99|-1 "%1%%% reduced Physical Damage" negate 1       
        lang "Traditional Chinese"
作者: Hsieh    時間: 2015-9-3 10:13

本帖最後由 Hsieh 於 2015-9-3 10:18 編輯

回復 1# yc1031 沒有技巧的方法
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary") '建立承接容器
  3. Open "stat_descriptions.txt" For Input As #1 '開啟文字檔
  4. Do While Not EOF(1)
  5.    i = i + 1
  6.    Input #1, mystr '將文字讀入變數
  7.    d.Add i, mystr '將文字寫入容器
  8.    If mystr = "lang ""Traditional Chinese""" Then
  9.    j = i
  10.      Do Until IsNumeric(d(j)) '判斷是否為數值
  11.      d.Remove j '移除
  12.      j = j - 1
  13.      Loop
  14.    End If
  15. Loop
  16. d.Remove j
  17. Close #1
  18. Sheets(2).[A1].Resize(d.Count, 1) = Application.Transpose(d.items) '寫入工作表
  19. End Sub
複製代碼
作者: yc1031    時間: 2015-9-3 11:06

回復 2# Hsieh


   您好, 十分感謝您的回覆!

我剛有試做, 但轉換過來,  都變成亂碼?
中間偵錯時, 就停留在"d.Remove j" 這一行

可否請您再看看? 謝謝。
作者: 准提部林    時間: 2015-9-3 12:18

提供在工作表直接方式（文字請手動貼入）：
Sub TEST20150903_2()
Dim Arr, Brr, R&, C&, i&, j%, TM, TT$, T, N&
TM = Timer
With ActiveSheet.UsedRange
　　Arr = .Value:  Brr = .Columns(1)
　　R = UBound(Arr, 1): C = UBound(Arr, 2)
End With

TT = "lang ""Traditional Chinese"""
For i = R To 1 Step -1
　　For j = 1 To C
　　　　If InStr("_" & Arr(i, j), TT) > 1 Then T = 1: Exit For
　　Next
　　If T = 0 Then Brr(i, 1) = i Else Brr(i, 1) = "": N = N + 1
　　For j = 1 To C
　　　　If IsNumeric(Arr(i, j) & "") Then T = 0: Exit For
　　Next j
Next
[K1].Resize(UBound(Brr)) = Brr
[A:K].Sort Key1:=[K1], Order1:=xlAscending, Header:=xlNo
Rows(R - N + 1 & ":" & R + 1).Clear
[K:K].Clear

MsgBox "完成．共刪除 " & N & " 行．耗時 " & Timer - TM & " 秒"
End Sub
　
這是第二種方法，範例檔有第一種方法，速度慢了許多：
[attach]21896[/attach]
　
作者: Hsieh    時間: 2015-9-3 22:53

回復 3# yc1031
直接用EXCEL開啟文字檔就不會亂碼
  1. Sub ex1()
  2. Dim A As Range
  3. fs = "D:\test\stat_descriptions.txt" '文字檔
  4. With Workbooks.Open(fs) '以EXCEL開啟文字檔
  5. Application.ScreenUpdating = False
  6.    With .Sheets(1)
  7.    Set A = .UsedRange.Find("lang ""Traditional Chinese""", lookat:=xlWhole) '尋找字串
  8.    Do Until A Is Nothing '直到找不到字串
  9.       r = A.Row
  10.       Do Until IsNumeric(.Cells(r, 2)) And .Cells(r, 2) <> "" '往上找數值
  11.         .Rows(r).Delete '刪除列
  12.         r = r - 1
  13.       Loop
  14.       .Rows(r).Delete
  15.    Set A = .UsedRange.Find("lang ""Traditional Chinese""", lookat:=xlWhole)
  16.    Loop
  17.    End With
  18. End With
  19. Application.ScreenUpdating = True
  20. End Su
複製代碼
作者: yc1031    時間: 2015-9-4 09:17

回復 4# 准提部林


真的很謝謝, 還弄了二種方法給我!

一直當伸手牌很不好意思, 我會努力看懂您提供的vba,  再次謝謝!
作者: yc1031    時間: 2015-9-4 09:18

回復 5# Hsieh



剛試了, 是成功的! 感謝感謝

想再請問一下, 貼回txt後,  發現每個句子後面都有些空格, 這個有辦法解決嗎?
作者: 准提部林    時間: 2015-9-4 12:04

第三種方式，刪除後輸出一文字檔（unicode格式）：
  1. Sub TEST20150903_3()
  2. Dim Arr, Brr, Crr, R&, C&, i&, j%, TM, TT$, T, N&
  3. Dim S, ST, uFile, TestObj, TxtFile
  4. TM = Timer
  5. Arr = Range([A1], ActiveSheet.UsedRange).Value
  6. R = UBound(Arr, 1): C = UBound(Arr, 2)
  7. 　
  8. ReDim Brr(1 To R, 1)
  9. TT = "lang ""Traditional Chinese"""
  10. For i = R To 1 Step -1
  11. 　　ST = ""
  12. 　　For j = C To 1 Step -1
  13. 　　　　S = Arr(i, j)
  14. 　　　　If ST <> "" And S = "" Then S = Chr(9)
  15. 　　　　ST = S & ST
  16. 　　Next
  17. 　　If InStr("_" & ST, TT) > 1 Then T = 1
  18. 　　If T = 0 Then N = N + 1: Brr(N, 0) = i: Brr(N, 1) = ST
  19. 　　If IsNumeric(ST) Then T = 0
  20. Next i
  21. 　
  22. With Sheets("結果表")　'此段用來檢查，可以刪去
  23. 　　.[A:B].Clear
  24. 　　.[A1:B1].Resize(N) = Brr
  25. 　　.[A:B].Sort Key1:=.[A1], Order1:=xlAscending, Header:=xlNo
  26. 　　Application.Goto .[A1]
  27. End With
  28. 　
  29. uFile = ThisWorkbook.Path & "\VVV.TXT"
  30. If Dir(uFile) <> "" Then Kill uFile
  31. Set TestObj = CreateObject("Scripting.FileSystemObject")
  32. Set TxtFile = TestObj.OpenTextFile(uFile, 8, True, -1)
  33. For i = N To 1 Step -1
  34. 　　TxtFile.WriteLine Brr(i, 1)
  35. Next i
  36. TxtFile.Close
  37. 　
  38. MsgBox "完成．共刪除 " & R - N & " 行．耗時 " & Timer - TM & " 秒"
  39. End Sub
複製代碼
[attach]21902[/attach]
　
作者: yc1031    時間: 2015-12-17 08:57

本帖最後由 yc1031 於 2015-12-17 08:59 編輯

回復 8# 准提部林


    [attach]22861[/attach]

您好, 想學習一下, 假如我也想把以下lang thai and lang Russian 都刪掉, 我只想留中文翻譯的部分, 即是紅字的部分都是要刪除的
那VBA該怎麼改呢?  感謝!

description                       
        1 item_generation_cannot_change_prefixes               
        1               
                # "Prefixes Cannot Be Changed"
        lang "Traditional Chinese"               
        1               
                # "▽ 前綴無法被變更"       
        lang "Thai"               
        1               
                # "ไม่สามารถเปลี่ยน Prefix ได้"       
        lang "Russian"               
        1               
                # "Префиксы нельзя изменить"       




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)