No.5-微信格式整理vba
' 微信格式整理
Sub Macro6()
Selection.AutoFilter
ActiveSheet.Range("$A$1:$D$8").AutoFilter Field:=1, Criteria1:="图片"
Rows("2:7").Select
Selection.Delete Shift:=xlUp
Range("A1:D1").Select
Selection.AutoFilter
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("D:D").Select
Selection.Cut Destination:=Columns("B:B")
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection.Font
.Name = "宋体"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Application.DisplayAlerts = False
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="：", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Selection.ColumnWidth = 62.56
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="+", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1)), TrailingMinusNumbers:=True
Range("B1").Select
Columns("B:B").ColumnWidth = 8.78
Range("B1").Select
ActiveCell.FormulaR1C1 = "类型"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("C1").Select
ActiveCell.FormulaR1C1 = "地点"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "个数"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("E1").Select
ActiveCell.FormulaR1C1 = "地址"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("F1").Select
ActiveCell.FormulaR1C1 = "目标"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("G1").Select
ActiveCell.FormulaR1C1 = "目标地址"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("E1").Select
ActiveCell.FormulaR1C1 = "地址"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("E1").Select
ActiveCell.FormulaR1C1 = "原地址"
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("H1").Select
ActiveCell.FormulaR1C1 = "状态"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("I1").Select
ActiveCell.FormulaR1C1 = "类型"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("C2").Select
ActiveCell.FormulaR1C1 = "辽宁"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C4")
Range("C2:C4").Select
Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="F", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("J:O").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="?", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.ColumnWidth = 32.89
Columns("E:E").Select
ActiveSheet.Range("$A$1:$I$8").RemoveDuplicates Columns:=5, Header:=xlYes
Range("E5").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
Range("J1").Select
ActiveCell.FormulaR1C1 = "结果"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Columns("J:J").Select
Selection.ColumnWidth = 43.67
Range("J2").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveCell.FormulaR1C1 = "=RC[-8]&""+""&RC[-7]&""+""&RC[-6]&""+""&RC[-5]&""+""&RC[-4]&""+""&RC[-3]&""+""&RC[-2]&""+""&RC[-1]"
Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J4")
Range("J2:J4").Select
Columns("D:D").Select
Selection.NumberFormatLocal = "@"
End Sub
浙公网安备 33010602011771号