[已解决]保留3个非零数字隔一个删一个数字请修改代码

ymq123 · 发表于 2015-1-14 10:08

修改程序代码
1、在工作表2中，如果每行数字大于等于4个时，只保留3个非零数字，删除多余的数字；小于等于3时，数字直接转到工作表3内。
2、删除方法是：第一个非0数字不删除，第二个非0数字删除，第三个非0数字不删除，第四个非0数字删除，以此类推每隔一个非0数字删除下一个非0数字，非0数字剩下3个时就不再向后删除数字。
3、删除结果放到工作表3内。
4、结果如工作表3。

最佳答案

月排行榜 / 总排行榜

ppp710715

2015-1-14 11:49

Sub tt()
arr = Sheets(2).[a1:j7]
For i = 1 To UBound(arr)
brr = Application.Index(arr, i, 0)
k = Application.CountA(brr)
If k <= 3 Then
Sheets(3).Range("a" & i).Resize(1, 10) = brr
Else
For j = 1 To UBound(brr)
If brr(j) > 0 Then n = n + 1
If n Mod 2 = 0 Then brr(j) = ""
If Application.Count(brr) = 3 Then _
Sheets(3).Range("a" & i).Resize(1, 10) = brr: Exit For
Next
End If
Next
End Sub

复制代码

跳转到最佳答案楼层

爱疯 · 发表于 2015-1-14 11:05

Private Sub CommandButton1_Click()
Dim A
A = Sheets(2).[A1:J7]
n = 3
For i = 1 To UBound(A)
      '1）求不为空的个数x
      x = 0
      For j = 1 To UBound(A, 2)
         If A(i, j) Then x = x + 1
      Next j

      '2）如果超过n，则清空
      If x > n Then
         For j = 1 To UBound(A, 2)
            If A(i, j) Then
                  y = y + 1
                  If y Mod 2 = 0 Then
                     A(i, j) = ""
                     x = x - 1
                     If x = n Then Exit For
                  End If
            End If
         Next j
      End If
Next i
Sheets(3).Cells.Clear
Sheets(3).Range("a1").Resize(UBound(A), UBound(A, 2)) = A
End Sub

2.rar (14.3 KB, 下载次数: 0)

雪舞子 · 发表于 2015-1-14 11:49

Sub test()
Dim i%, j%, x%, y%, n%, l%
With Sheets("3")
Sheets("2").UsedRange.Copy .Range("a1") '复制源数据到表3
x = .UsedRange.Columns.Count '列宽
For i = 1 To .UsedRange.Rows.Count '循环数据源1至最后一行
y = Application.Count(.Rows(i)) '统计每一行非空单元格
If y > 3 Then '超过3个非空
n = 0: l = 0: j = 0 'n非空位置，l删除个数，j列数
Do
j = j + 1
If .Cells(i, j).Value <> "" Then n = n + 1
If n > 0 And n Mod 2 = 0 Then .Cells(i, j).ClearContents: l = l + 1
Loop Until l > y - 4
End If
Next
.Select
End With
End Sub

复制代码

保留3个非零数字.rar (12.06 KB, 下载次数: 3)

ppp710715 · 发表于 2015-1-14 11:49

这个最佳答案由 ppp710715 给出，感谢 ppp710715 的回答。

单击隐藏图章

Sub tt()
arr = Sheets(2).[a1:j7]
For i = 1 To UBound(arr)
brr = Application.Index(arr, i, 0)
k = Application.CountA(brr)
If k <= 3 Then
Sheets(3).Range("a" & i).Resize(1, 10) = brr
Else
For j = 1 To UBound(brr)
If brr(j) > 0 Then n = n + 1
If n Mod 2 = 0 Then brr(j) = ""
If Application.Count(brr) = 3 Then _
Sheets(3).Range("a" & i).Resize(1, 10) = brr: Exit For
Next
End If
Next
End Sub

复制代码

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

[已解决]保留3个非零数字 隔一个删一个数字 请修改代码

评分

[已解决]保留3个非零数字隔一个删一个数字请修改代码