Yn nogfen Word, efallai y bydd rhai tablau gyda rhesi dyblyg yr ydych am eu tynnu a chadw'r ymddangosiad cyntaf yn un weithiau. Yn yr achos hwn, gallwch ddewis cael gwared ar y rhai dyblyg fesul un â llaw, hefyd gallwch ddewis defnyddio'r cod VBA.
1. Rhowch y cyrchwr wrth y bwrdd rydych chi am dynnu'r rhesi dyblyg ohono, gwasgwch Alt + F11 allweddi i alluogi'r Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.
2. Cliciwch Mewnosod > Modiwlau i greu Modiwl newydd.
3. Copïwch isod y codau a'u pastio i'r newydd Modiwlau sgript.
VBA: Tynnwch resi dyblyg o'r tabl yn Word
Public Sub DeleteDuplicateRows2()
'UpdatebyExtendoffice20181011
Dim xTable As Table
Dim xRow As Range
Dim xStr As String
Dim xDic As Object
Dim I, J, KK, xNum As Long
If ActiveDocument.Tables.Count = 0 Then
MsgBox "This document does not have table(s).", vbInformation, "Kutools for Word"
Exit Sub
End If
Application.ScreenUpdating = False
Set xDic = CreateObject("Scripting.Dictionary")
If Selection.Information(wdWithInTable) Then
Set xTable = Selection.Tables(1)
For I = xTable.Rows.Count To 1 Step -1
Set xRow = xTable.Rows(I).Range
xStr = xRow.Text
xNum = -1
If xDic.Exists(xStr) Then
' xTable.Rows(I).Delete
For J = xTable.Rows.Count To 1 Step -1
If (xStr = xTable.Rows(J).Range.Text) And (J <> I) Then
xNum = xNum + 1
xTable.Rows(J).Delete
End If
Next
I = I - xNum
Else
xDic.Add xStr, I
End If
Next
Else
For I = 1 To ActiveDocument.Tables.Count
Set xTable = ActiveDocument.Tables(I)
xNum = -1
xDic.RemoveAll
For J = xTable.Rows.Count To 1 Step -1
Set xRow = xTable.Rows(J).Range
xStr = xRow.Text
xNum = -1
If xDic.Exists(xStr) Then
' xTable.Rows(I).Delete
For KK = xTable.Rows.Count To 1 Step -1
If (xStr = xTable.Rows(KK).Range.Text) And (KK <> J) Then
xNum = xNum + 1
xTable.Rows(KK).Delete
End If
Next
J = J - xNum
Else
xDic.Add xStr, J
End If
Next
Next
End If
Application.ScreenUpdating = True
End Sub
4. Gwasgwch F5 allwedd i redeg y cod, yna bydd yr holl resi dyblyg yn cael eu tynnu.
Nodyn: Mae'r cod uchod yn sensitif i achosion, os ydych chi am gael gwared â rhesi dyblyg rhag ofn ansensitif, gallwch ddefnyddio isod y cod:
Public Sub DeleteDuplicateRows2()
'UpdatebyExtendoffice20181011
Dim xTable As Table
Dim xRow As Range
Dim xStr As String
Dim xDic As Object
Dim I, J, KK, xNum As Long
If ActiveDocument.Tables.Count = 0 Then
MsgBox "This document does not have table(s).", vbInformation, "Kutools for Word"
Exit Sub
End If
Application.ScreenUpdating = False
Set xDic = CreateObject("Scripting.Dictionary")
If Selection.Information(wdWithInTable) Then
Set xTable = Selection.Tables(1)
For I = xTable.Rows.Count To 1 Step -1
Set xRow = xTable.Rows(I).Range
xStr = UCase(xRow.Text)
xNum = -1
If xDic.Exists(xStr) Then
' xTable.Rows(I).Delete
For J = xTable.Rows.Count To 1 Step -1
If (xStr = xTable.Rows(J).Range.Text) And (J <> I) Then
xNum = xNum + 1
xTable.Rows(J).Delete
End If
Next
I = I - xNum
Else
xDic.Add xStr, I
End If
Next
Else
For I = 1 To ActiveDocument.Tables.Count
Set xTable = ActiveDocument.Tables(I)
xNum = -1
xDic.RemoveAll
For J = xTable.Rows.Count To 1 Step -1
Set xRow = xTable.Rows(J).Range
xStr = UCase(xRow.Text)
xNum = -1
If xDic.Exists(xStr) Then
' xTable.Rows(I).Delete
For KK = xTable.Rows.Count To 1 Step -1
If (xStr = xTable.Rows(KK).Range.Text) And (KK <> J) Then
xNum = xNum + 1
xTable.Rows(KK).Delete
End If
Next
J = J - xNum
Else
xDic.Add xStr, J
End If
Next
Next
End If
Application.ScreenUpdating = True
End Sub
Os ydych chi am gael gwared â rhesi dyblyg ym mhob tabl o'r ddogfen, rhowch y cyrchwr mewn unrhyw le dogfen y tu allan i'r tabl, yna cymhwyswch un o'r codau uchod.
Tab Office: Yn dod â rhyngwynebau tabiau i Word, Excel, PowerPoint ...
Gwnewch Mwy mewn Llai o Amser gyda Kutools wedi'i Wella gan AI ar gyfer Word
Nid set o offer yn unig yw Kutools ar gyfer Word - mae'n ddatrysiad smart sydd wedi'i gynllunio i roi hwb i'ch cynhyrchiant. Gyda galluoedd a yrrir gan AI a'r nodweddion mwyaf hanfodol, mae Kutools yn eich helpu i gyflawni mwy mewn llai o amser:
Cynhyrchu cynnwys sy'n cyfateb yn berffaith i'ch anghenion.
Trawsnewidiwch eich ysgrifennu gyda dros 20 o arddulliau ysgrifennu, gan sicrhau ei fod yn ddi-fai.
Crynhowch eich dogfen mewn un clic.
Cyfieithwch eich cynnwys i dros 40 o ieithoedd yn rhwydd, gan ehangu eich cyrhaeddiad yn fyd-eang.
Derbyn cymorth a gwybodaeth ar unwaith am eich dogfen.
Gofynnwch am brosesu dogfennau, ac os oes gan Kutools yr offeryn, bydd y Cynorthwy-ydd AI yn cyflawni'ch tasg ar unwaith ar eich gorchymyn, gan roi pŵer llawn Word ar flaenau eich bysedd.
Gofynnwch unrhyw gwestiwn heb adael Word - wedi'i integreiddio'n ddi-dor, mae'r Cynorthwy-ydd AI bob amser o fewn cyrraedd.
Cynhyrchu, ailysgrifennu, crynhoi, a chyfieithu cynnwys gyda chliciau.
Derbyn cymorth a gwybodaeth ar unwaith am eich dogfen.
Gofynnwch am brosesu dogfennau, a bydd y Cynorthwy-ydd AI yn cyflwyno'r offeryn cywir ac yn cyflawni'r dasg, neu'n eich tywys trwy'r camau.
Gofynnwch unrhyw gwestiwn heb adael Word - wedi'i integreiddio'n ddi-dor, mae'r Cynorthwy-ydd AI bob amser o fewn cyrraedd.
