如果C列不为空则整行数据复制（有关速度问题)

神秘风暴

于箱长 发表于 2024-8-12 19:21
需要用wps（不是所有的版本都支持）打开，开发工具->切换到JS环境

额，明白了，感觉有点像是网页的代码似的。

神秘风暴

quqiyuan 发表于 2024-8-12 16:40
代码如下。。。
Sub cmdInsertRow0811()
    Application.ScreenUpdating = False '//关闭屏幕刷新

老师，还有没搞懂，在确保总时间不变的情况下，如果人员有三个人的话，要确保姓名B，姓名C的人员都归到姓名A的列，该如何写呢？（条件：确保姓名A列不空的情况下：某行姓名B列空，某行姓名C列空,某行姓名A\B\C列全都不空），脑子转不过弯，我还是太笨！

神秘风暴

神秘风暴 发表于 2024-8-13 15:16
老师，还有没搞懂，在确保总时间不变的情况下，如果人员有三个人的话，要确保姓名B，姓名C的人员都归到姓 ...

自己改来改去，这样子，功能实现了，不知道对不对，哈哈！

1. Sub InsertRow() '//24-08-03
   
2.     Application.ScreenUpdating = False '//关闭屏幕刷新
   
3.     Application.DisplayAlerts = False '//关闭系统提示
   
4.     Dim SH As Worksheet
   
5.     Dim t
   
6.     t = Timer   '//开始时间
   
7.     Set SH = Sheets("台账")
   
8.     If SH.FilterMode Then SH.ShowAllData
   
9.     MaxRow = SH.Range("B" & Rows.Count).End(xlUp).Row
   
10.     'Debug.Print maxrow
    
11.     MaxColumn = SH.Cells(1, Columns.Count).End(1).Column
    
12.     arr = SH.Range("a1", Cells(MaxRow, MaxColumn))
    
13.     ReDim brr(1 To 1048576, 1 To MaxColumn)
    
14.     For i = 3 To MaxRow '//从第三行开始
    
15.         If Len(arr(i, 3)) > 0 And Len(arr(i, 4)) > 0 Then '如果C列和D列不为空
    
16.             arr(i, 8) = arr(i, 8) / 3 '所用的时间姓名A与B与C平均
    
17.             For k = 1 To 2
    
18.                 n = n + 1
    
19.                 For j = 1 To UBound(arr, 2)
    
20.                     brr(n, j) = arr(i, j)
    
21.                 Next
    
22.             Next
    
23.             brr(n, 2) = brr(n - 1, 3)
    
24.             brr(n, 3) = brr(n - 1, 4)
    
25.             brr(n, 8) = brr(n - 1, 8) * 2
    
26.             brr(n - 1, 3) = Empty: brr(n - 1, 4) = Empty: brr(n, 4) = Empty
    
27.         ElseIf Len(arr(i, 3)) > 0 Then
    
28.             arr(i, 8) = arr(i, 8) / 2 '所用的时间姓名A与B平均
    
29.             For k = 1 To 2
    
30.                 n = n + 1
    
31.                 For j = 1 To UBound(arr, 2)
    
32.                     brr(n, j) = arr(i, j)
    
33.                 Next
    
34.             Next
    
35.             brr(n, 2) = brr(n - 1, 3)
    
36.             brr(n, 8) = brr(n - 1, 8)
    
37.             brr(n, 3) = Empty: brr(n - 1, 3) = Empty
    
38.         Else
    
39.             n = n + 1
    
40.             For j = 1 To UBound(arr, 2)
    
41.                 brr(n, j) = arr(i, j)
    
42.             Next
    
43.         End If
    
44.     Next
    
45.     SH.[A3].Resize(n, MaxColumn) = brr
    
46.     Application.ScreenUpdating = True '//恢复屏幕刷新
    
47.     Application.DisplayAlerts = True '//恢复系统提示
    
48.     MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒，" & "请查看结果!", , "系统提示!!" '//提示所用时间
    
49. End Sub
    
50. 
    

复制代码

于箱长

神秘风暴 发表于 2024-8-13 15:39
自己改来改去，这样子，功能实现了，不知道对不对，哈哈！

未经测试，大概看了一下，好像不对，你自己看看结果是不是自己想要的吧

神秘风暴

于箱长 发表于 2024-8-13 15:56
未经测试，大概看了一下，好像不对，你自己看看结果是不是自己想要的吧

不对，需要运行两次才对！因第一次运行之后姓名C跑到姓名B里就结束了

sunya_0529

神秘风暴 发表于 2024-8-13 15:16
老师，还有没搞懂，在确保总时间不变的情况下，如果人员有三个人的话，要确保姓名B，姓名C的人员都归到姓 ...

根据人员数来拆分的话，要考虑是否存在多个人的情况，一直增加列可能不是个好主意。
可以考虑在B列里用下面的方式来写：
A、B、C、D

然后后面的时间根据B列里的人数作均分。这样写出来的代码可以通用。

于箱长

sunya_0529 发表于 2024-8-13 18:01
根据人员数来拆分的话，要考虑是否存在多个人的情况，一直增加列可能不是个好主意。
可以考虑在B列里用 ...

就怕他整的姓名之间的分隔符号不统一，啥样的都有……

sunya_0529

于箱长 发表于 2024-8-13 18:13
就怕他整的姓名之间的分隔符号不统一，啥样的都有……

嗯，数据搞规范点，怎么处理都方便。

简单演示一下——

quqiyuan

神秘风暴 发表于 2024-8-13 15:16
老师，还有没搞懂，在确保总时间不变的情况下，如果人员有三个人的话，要确保姓名B，姓名C的人员都归到姓 ...

道理是一样的，分清楚数组的列（二维）号就可以，不过我看你发的代码好像不是很对，你再检查一下吧，方法都是对的