条件移列

ddz79101 · 发表于 2024-12-14 11:07

老师！有张表格有时会有6列，有时会有5列，若为5列，则不作处理；若为6列时，则需移动列单元格到空格。请老师看看。谢谢！

z865593849 · 发表于 2024-12-14 11:26

要上传实际5,6列的情况，看不明白

ddz79101 · 发表于 2024-12-14 11:34

z865593849 发表于 2024-12-14 11:26
要上传实际5,6列的情况，看不明白

老师！表格中是6列，左边图片是这表格6列变5列结果；右边图片是实际上的5列。我的意思是表格有时是6列，有时是5列，代码要求是处理表格6列情况，5列跳过。

gwjkkkkk · 发表于 2024-12-14 11:46

Option Explicit
Sub TEST1()
Dim ar, i&

With [A1].CurrentRegion
      ar = .Value
      If UBound(ar, 2) = 5 Then Exit Sub
      For i = 2 To UBound(ar)
         If Len(ar(i, 3)) = 0 Then .Cells(i, 3) = .Cells(i, 4)
      Next i
         .Columns("D").Delete
      End With
Beep
End Sub

gwjkkkkk · 发表于 2024-12-14 11:47

请参考。。。

chxw68 · 发表于 2024-12-14 12:07

Sub test()
Dim r%, i%
Dim arr, brr
With Worksheets("sheet1")
c = .Cells(1, 1).End(xlToRight).Column
If c = 6 Then
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:f" & r)
ReDim brr(1 To UBound(arr), 1 To 5)
For i = 1 To UBound(arr)
brr(i, 1) = arr(i, 1)
brr(i, 2) = arr(i, 2)
If arr(i, 3) = Empty Then
brr(i, 3) = arr(i, 4)
Else
brr(i, 3) = arr(i, 3)
End If
brr(i, 4) = arr(i, 5)
brr(i, 5) = arr(i, 6)
Next
.Cells(1, 4).Delete shift:=xlToLeft
.Range("a2:e" & r) = brr
End If
End With
End Sub

复制代码

chxw68 · 发表于 2024-12-14 12:08

参与一下。

alimjan15 · 发表于 2024-12-14 12:08

新建一个模块增加代码如下：
Sub 合并()
Dim i%
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
      If Cells(i, 3) = "" And Cells(i, 4) <> "" Then
         Cells(i, 3) = Cells(i, 4)
      End If
Next
Columns("d:d").Delete shift:=xlToLeft
End Sub

alimjan15 · 发表于 2024-12-14 12:16

Sub 合并()
Dim i%
If Cells(1, 6) <> "" Then
      For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
         If Cells(i, 3) = "" And Cells(i, 4) <> "" Then
            Cells(i, 3) = Cells(i, 4)
         End If
      Next
      Columns("d:d").Delete shift:=xlToLeft
End If
End Sub

ddz79101 · 发表于 2024-12-14 14:00

gwjkkkkk 发表于 2024-12-14 11:47
请参考。。。

谢谢老师！运行成功

		自动登录	找回密码
密码			免费注册

[求助] 条件移列

评分

评分

评分

评分