如何用vba或者更快运算

m25763989

自己搞了个表格，但是用了excel的基本公式拼出来，运算起来很卡很慢，只能求助转换为vba编写，在第三个工作本无数据不显示遗漏值增加，最好是来个最后列有数据自动降序

liulang0808

楼主结合附件内容，举例说明具体实现过程，别整公式

m25763989

liulang0808 发表于 2020-3-8 08:51
楼主结合附件内容，举例说明具体实现过程，别整公式

好的，首先是录入每期数据，为（1~49），这1~49我划分为123456789abc共12个，（如1、13、25、37、49划分为1；10、22、34、46划分为a），将123456789abc共12个每6个组合，共有924种组合（比如123456和789abc）。比如附件sheet1的b2录入12（12属于c，sheet3的b2意思c不属于123456，遗漏等于a2值+1，a2值为0，所以0+1=1），sheet1的c2录入36（36属于c，sheet3的c2意思c不属于123456，遗漏值等于b2的1+1=2），sheet1的d2录入25（25属于1，sheet3的d2意思是1属于123456，遗漏值归1）
求助：1.当sheet1的第二行第几列有录入数据，sheet3的对于第几列有数据显示，后为空白，并且最后列降序排列；
2，完善表格924种组合完整列出，人工列出，压力太大了。

一把小刀闯天下

'"sheet2"工作表没用，"遗漏值归1"没看懂，如果都存在这个值应该为0

'"后为空白，并且最后列降序排列",为空怎么去降序。先猜一个，，，

Option Explicit

Sub test()
  Dim arr, brr, i, j, mark, t
  mark = Split("c,1,2,3,4,5,6,7,8,9,a,b", ",")
  With Sheets("sheet1")
    arr = .Range("a2:a" & .[a1].End(xlDown).Row).Resize(, 76).Value
  End With
  With Sheets("sheet3")
    .[b2].Resize(.[a1].End(xlDown).Row - 1, 75).ClearContents
    brr = .Range("a2:a" & .[a1].End(xlDown).Row).Resize(, 76).Value
    For i = 1 To UBound(arr, 1)
      For j = 2 To UBound(arr, 2)
        If Len(arr(i, j)) Then
          t = mark(arr(i, j) Mod ((UBound(mark)) + 1))
          If j = 2 Then
            If InStr(brr(i, 1), t) Then
              brr(i, j) = 0
            Else
              brr(i, j) = 1
            End If
          Else
            If InStr(brr(i, 1), t) Then
              brr(i, j) = 1
'              brr(i, j) = brr(i, j - 1) - 1
            Else
              brr(i, j) = brr(i, j - 1) + 1
            End If
          End If
        End If
      Next
    Next
    .[a2].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
  End With
End Sub