符合條件, 刪除多行

yc1031

各位好

我想請教各位刪除多行的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

回復 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

回復 2# Hsieh


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

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

可否請您再看看? 謝謝。

准提部林

提供在工作表直接方式（文字請手動貼入）：
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
　
這是第二種方法，範例檔有第一種方法，速度慢了許多：
Xl0000085.rar (261.43 KB)

下載次數: 8

2015-9-3 12:18

　

Hsieh

回復 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

回復 4# 准提部林


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

一直當伸手牌很不好意思, 我會努力看懂您提供的vba,  再次謝謝!

yc1031

回復 5# Hsieh



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

想再請問一下, 貼回txt後,  發現每個句子後面都有些空格, 這個有辦法解決嗎?

准提部林

第三種方式，刪除後輸出一文字檔（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

複製代碼

Xl0000085v02.rar (267.16 KB)

下載次數: 5

2015-9-4 12:03

　

yc1031

回復 8# 准提部林


    Xl0000085v02.rar (579.23 KB)

下載次數: 3

2015-12-17 08:53

您好, 想學習一下, 假如我也想把以下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               
                # "Префиксы нельзя изменить"