多工作表数据转化的问题

dfshm

附件 数据转化附件.rar (201.42 KB, 下载次数: 7)

2023-3-4 09:52 上传

点击文件名下载附件

谢谢老师！

shiruiqiang

dfshm

shiruiqiang 发表于 2023-3-4 10:06

老师你好，谢谢帮助。试了一下，返回的结果不是要集中在Sheet0中。而是要返回到各工作表中。

shiruiqiang

dfshm 发表于 2023-3-4 10:43
老师你好，谢谢帮助。试了一下，返回的结果不是要集中在Sheet0中。而是要返回到各工作表中。

把for i=2 to
修改成for each sht in sheets。
arr=sht.range("h1:h10000")
因为你的第一张表格式和其余三张不同

谢玉红

shiruiqiang 发表于 2023-3-4 10:57
把for i=2 to
修改成for each sht in sheets。
arr=sht.range("h1:h10000")

333333333333333333333333333333

dfshm

shiruiqiang 发表于 2023-3-4 10:57
把for i=2 to
修改成for each sht in sheets。
arr=sht.range("h1:h10000")

Sub test()
Dim arr, brr(1 To 1000000, 1 To 3)

Dim sht As Worksheet
For Each sht In Sheets
  arr = sht.Range("h1:h10000")
      For x = 1 To UBound(arr)
        If arr(x, 2) <> " " Then
        k = k + 1
        brr(k, 1) = arr(x, 2)
        brr(k, 2) = arr(x, 2) Mod 36
        brr(k, 3) = arr(x, 2) Mod 49
        End If
    Next
Next
Sheets("sheet0").[h1].Resize(k, 3) = brr
End Sub

老师你好，这样修改吗？执行不了啊。

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, i&, j&, wks As Worksheet
   
    Application.ScreenUpdating = False
    For Each wks In Sheets
        If wks.Name <> "Sheet0" Then
            With wks
                ar = Range(.[H1], .Cells(Rows.Count, "H").End(xlUp))
                ReDim Preserve ar(1 To UBound(ar), 1 To 3)
                For i = 1 To UBound(ar)
                    ar(i, 2) = IIf(ar(i, 1) Mod 36 = 0, 36, ar(i, 1) Mod 36)
                    ar(i, 3) = IIf(ar(i, 1) Mod 49 = 0, 49, ar(i, 1) Mod 49)
                Next i
                .[H1].Resize(UBound(ar), 3) = ar
            End With
        End If
    Next
   
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

dfshm 发表于 2023-3-4 11:47
Sub test()
Dim arr, brr(1 To 1000000, 1 To 3)

请楼主参考。。。