分类统计框选的单元格数量

海星_0920

想写一个基于VBA的斗地主记牌器，但苦于以前没写过这种类型的VBA，主体计算程序不知道从哪里开始下手，其他的写了一点点。希望大哥大姐们有空的话能帮个忙，哪怕提一点灵感也行，拜谢！（具体要求在附件）

NadrsSaber

感觉可以用字典解决

海星_0920

NadrsSaber 发表于 2020-2-10 15:24
感觉可以用字典解决

好的，谢谢，我去试试

海星_0920

NadrsSaber 发表于 2020-2-10 15:24
感觉可以用字典解决

老哥，我突然有灵感了，但是我又遇到了新的问题。在论坛上找到了解决方法，但是代码我看不懂，尝试修改之后一直出错，下面是源代码。我想把他改成固定的单元格，而不需要每次都弹出一个窗口让用户选择单元格。

Sub 多区域复制()

    On Error Resume Next
    Dim SRange() As Range, UPRange As Range, TRange As Range
    Dim i As Long, AreaNum As Long
    Dim MinR As Long, MinC As Long
    AreaNum = Selection.Areas.Count
    ReDim SRange(1 To AreaNum)
    MinR = ActiveSheet.Rows.Count
    MinC = ActiveSheet.Columns.Count
    For i = 1 To AreaNum
        Set SRange(i) = Selection.Areas(i)
        If SRange(i).Row < MinR Then MinR = SRange(i).Row
        If SRange(i).Column < MinC Then MinC = SRange(i).Column
    Next i
    Set UPRange = Cells(SRange(1).Row, SRange(1).Column)
    Set TRange = Application.InputBox(prompt:="选择粘贴区域的最左上角单元格", Title:="多区域复制粘贴", Type:=8)
    Application.ScreenUpdating = False
    For i = 1 To AreaNum
        SRange(i).Copy
        TRange.Offset(SRange(i).Row - MinR, SRange(i).Column - MinC).PasteSpecial Paste:=xlPasteValues
    Next i
    Application.ScreenUpdating = True

End Sub

海星_0920

已经完成，此贴终结，留下附件造福后来人，没准可以给你们点灵感。