[第41问]请帮我修改表格中的代码

hbhs2022

见附件说明。

发哥76

Private Sub CommandButton1_Click()
Dim i&, j%, arr, brr, c%
t = Timer
Application.ScreenUpdating = False
[b4:aw10000].ClearContents
[b4:aw10000].NumberFormatLocal = "@"
arr = Sheet1.Range("a1:j" & Sheet1.Cells(Rows.Count, 3).End(xlUp).Row)
ReDim brr(1 To UBound(arr) - 1, 1 To 48)
For i = 2 To UBound(arr)
    For j = 4 To 10
        c = arr(i, j)
        If j < 9 Then
            brr(i - 1, c + 1) = Cells(3, c + 2)
        Else
            brr(i - 1, c + 36) = Cells(3, c + 37)
        End If
   Next
   brr(i - 1, 1) = arr(i, 3)
Next
[b4].Resize(UBound(brr), 48) = brr
Application.ScreenUpdating = True
MsgBox "填充完成 ！ 耗时 ： " & Format(Timer - t, "0.00" & " 秒"), , "提示"
End Sub

hbhs2022

发哥76 发表于 2024-5-12 15:02
Private Sub CommandButton1_Click()
Dim i&, j%, arr, brr, c%
t = Timer

这个问题要简单些，谢谢你！

hbhs2022

发哥76 发表于 2024-5-12 15:02
Private Sub CommandButton1_Click()
Dim i&, j%, arr, brr, c%
t = Timer

刚才发现一个问题，如果提前设置期号，更新出错。
如何再一次修改代码？

hbhs2022

发哥76 发表于 2024-5-12 15:02
Private Sub CommandButton1_Click()
Dim i&, j%, arr, brr, c%
t = Timer

期号可以更新，号码有就填充，没有就不填充。

发哥76

hbhs2022 发表于 2024-5-12 15:22
期号可以更新，号码有就填充，没有就不填充。

Private Sub CommandButton1_Click()
Dim i&, j%, arr, brr, c%
t = Timer
Application.ScreenUpdating = False
[b4:aw10000].ClearContents
[b4:aw10000].NumberFormatLocal = "@"
arr = Sheet1.Range("a1:j" & Sheet1.Cells(Rows.Count, 3).End(xlUp).Row)
ReDim brr(1 To UBound(arr) - 1, 1 To 48)
For i = 2 To UBound(arr)
    For j = 4 To 10
        c = arr(i, j)
       If c = Empty Then
            Exit For
        Else
            If j < 9 Then
                brr(i - 1, c + 1) = Cells(3, c + 2)
            Else
                brr(i - 1, c + 36) = Cells(3, c + 37)
            End If
       End If
   Next
   brr(i - 1, 1) = arr(i, 3)
Next
[b4].Resize(UBound(brr), 48) = brr
Application.ScreenUpdating = True
MsgBox "填充完成 ！ 耗时 ： " & Format(Timer - t, "0.00" & " 秒"), , "提示"
End Sub

hbhs2022

发哥76 发表于 2024-5-12 15:57
Private Sub CommandButton1_Click()
Dim i&, j%, arr, brr, c%
t = Timer

非常完美，谢谢你！

hbhs2022

发哥76 发表于 2024-5-12 15:57
Private Sub CommandButton1_Click()
Dim i&, j%, arr, brr, c%
t = Timer

你好！再帮我看看，我加了一些代码（以前求助问题的代码），靛蓝为遗漏值。如何再一次修改代码？使遗漏值填充在号码出现的位置，而不是填充在期号对应的位置。红色数字手填了一些。

hbhs2022

发哥76 发表于 2024-5-12 15:57
Private Sub CommandButton1_Click()
Dim i&, j%, arr, brr, c%
t = Timer

Sub tc(brr)
Dim j%, i%, n%, c%
Application.ScreenUpdating = False
For j = 1 To 48
    n = 0
        For i = 1 To UBound(brr)
           If brr(i, j) = "" Then
           If i = 1 Then n = 1 Else n = n + 1
           If i = UBound(brr) Then brr(i, j) = n
        Else
           If n > 0 Then brr(i - 1, j) = n
           n = 0
        End If
    Next
Next
Application.ScreenUpdating = True
End Sub

发哥76

hbhs2022 发表于 2024-5-12 17:04
Sub tc(brr)
Dim j%, i%, n%, c%
Application.ScreenUpdating = False

笨办法，先用循环找到有号码的最大行，
Sub tc(brr)
Dim j%, i%, n%, maxr%
Application.ScreenUpdating = False
For i = 2 To 48
    For j = 1 To UBound(brr)
        If brr(j, i) <> Empty Then
            maxr = Application.Max(j, maxr)
        End If
    Next
Next
For j = 1 To 48
    n = 0
        For i = 1 To UBound(brr)
           If brr(i, j) = "" Then
           If i = 1 Then n = 1 Else n = n + 1
           If i = maxr Then brr(i, j) = n
        Else
           If n > 0 Then brr(i - 1, j) = n
           n = 0
        End If
    Next
Next
Application.ScreenUpdating = True
End Sub