Skip to content

Instantly share code, notes, and snippets.

@winse
Last active August 29, 2015 14:01
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save winse/0d99f1e680f41b0c0d7a to your computer and use it in GitHub Desktop.
Save winse/0d99f1e680f41b0c0d7a to your computer and use it in GitHub Desktop.
excel行数据处理,去掉行内与第一列数据相同的单元格
Sub 处理行内去掉与第一列相同的数据()
' 整个过程使用:
'
' 1. 选中需要转换的数据区域
' 2. 点击宏
'
Dim sel As Variant
Set sel = Selection
Dim SourceStartCell As Variant
Set SourceStartCell = sel
' 横向 纵向
Dim i, j As Integer
i = 0
j = 0
Dim rowFirstColumnValue As String
For Each Value In sel
If (Value.Column - SourceStartCell.Column) > i Then
i = i + 1
End If
If (Value.Row - SourceStartCell.Row) > j Then
i = 0
j = j + 1
End If
If (i = 0) Then
rowFirstColumnValue = Value.Value
Else
If (rowFirstColumnValue = Value.Value) Then
Value.Value = ""
End If
End If
Next
' i,j为最大行列数
ii = 0
jj = 0
While jj <= j
cols = i
While ii <= cols
If (sel.Worksheet.Cells(SourceStartCell.Row + jj, SourceStartCell.Column + ii).Value = "") Then
iii = ii
While (iii <= i)
sel.Worksheet.Cells(SourceStartCell.Row + jj, SourceStartCell.Column + iii).Value = sel.Worksheet.Cells(SourceStartCell.Row + jj, SourceStartCell.Column + iii + 1).Value
iii = iii + 1
Wend
cols = cols - 1
Else
ii = ii + 1
End If
Wend
ii = 0
jj = jj + 1
Wend
End Sub
@winse
Copy link
Author

winse commented May 27, 2014

48行需要改进,如果存在多个空格!没有考虑!

@version2 fix

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment