在vbscript中如何处理合并单元格？

Question

A   a1    100
    a2    200
    a3    50
B   b1    300
    b2    200
C   c1    200
    c2    100
如上表格
A、B、C为公司名
a1 a2 a3 b1 b2 c1 c2为报价，报价可能相同
第3列为购买量。
要求，针对不同的报价，在每个公司中找出高于报价的购买量的最大值
例如：
A    1.00  100
     1.30  200
     1.70  50
B    1.30  300
     1.20  200
C    2.00  200
     1.60  100
输出结果为：
1.00 A 200 B 300 C 200
1.20 A 200 B 300 C 200
1.30 A 200 B 300 C 200
1.60 A 50  B 0   C 200
1.70 A 50  B 0   C 200
2.00 A 0   B 0   C 200

Answer 1

可以用   .mergearea.count
来处理。

Answer 2

Option ExplicitDim CompanyArray() As Integer
Dim CompanySortArray() As Integer
Dim CompanyUniqeArray() As Integer
Dim PriceArray() As Double
Dim PriceSortArray() As Double
Dim PriceUniqeArray() As Double
Dim VolumeArray() As Integer
Dim VolumeSortArray() As Integer
Dim Counter As Integer
Dim Done As Boolean
Dim i, j As Integer
Dim temp As Variant
Dim Total As Integer
Dim VolumeSum As Integer
Dim TStore As Integer
Dim MyRange As Range
Dim Element As Variant
Dim CNum, PNum, VNum As Integer
Private Sub CommandButton1_Click()
'取有效纪录数
    Total = Worksheets("Sheet1").UsedRange.Rows.Count
'初始化数组
    ReDim CompanyArray(Total)
    ReDim CompanySortArray(Total)
    ReDim CompanyUniqeArray(Total)
    ReDim PriceArray(Total)
    ReDim PriceSortArray(Total)
    ReDim PriceUniqeArray(Total)
    ReDim VolumeArray(Total)
    ReDim VolumeSortArray(Total)
    
    j = 0
    While (Total - j > 1)
        If Worksheets("Sheet1").Cells(j + 2, 1).MergeCells Then
            temp = Worksheets("Sheet1").Cells(j + 2, 1).Value
            For i = 0 To Worksheets("Sheet1").Cells(j + 2, 1).MergeArea.Count - 1
                If temp <> "" Then CompanyArray(j) = temp
                j = j + 1
            Next i
        Else
            If Worksheets("Sheet1").Cells(j + 2, 1).Value <> "" Then CompanyArray(j) = Worksheets("Sheet1").Cells(j + 2, 1).Value
            j = j + 1
        End If
    Wend
    
    For Counter = 1 To Total - 1
        If Worksheets("Sheet1").Cells(Counter + 1, 2).Value <> "" Then PriceArray(Counter - 1) = Worksheets("Sheet1").Cells(Counter + 1, 2).Value
        If Worksheets("Sheet1").Cells(Counter + 1, 3).Value <> "" Then VolumeArray(Counter - 1) = Worksheets("Sheet1").Cells(Counter + 1, 3).Value
    Next Counter
    
    For Counter = 1 To Total - 1
        Worksheets("Sheet1").Cells(Counter + 1, 6).Value = CompanyArray(Counter - 1)
        Worksheets("Sheet1").Cells(Counter + 1, 7).Value = PriceArray(Counter - 1)
        Worksheets("Sheet1").Cells(Counter + 1, 8).Value = VolumeArray(Counter - 1)
    Next Counter
    
    CNum = 0
    For i = 1 To Total - 1
        If CompanyArray(i - 1) <> 0 Then CNum = CNum + 1
    Next i
    
    PNum = 0
    For i = 1 To Total - 1
        If PriceArray(i - 1) <> 0 Then PNum = PNum + 1
    Next i
    
    VNum = 0
    For i = 1 To Total - 1
        If VolumeArray(i - 1) <> 0 Then VNum = VNum + 1
    Next i    If CNum <> PNum Or PNum <> VNum Then
        MsgBox ("公司、价格、数量没有对齐，不匹配！")
        Return
    End If
    
    Total = CNum
    For i = 0 To Total - 1
        If (CompanyArray(i) = 0 Or PriceArray(i) = 0 Or VolumeArray(i) = 0) Then
            MsgBox ("公司、价格、数量不能为空")
            Return
        End If
    Next i
    
    For Counter = 0 To Total - 1
        CompanySortArray(Counter) = CompanyArray(Counter)
    Next Counter
    
    For Counter = 0 To Total - 1
        PriceSortArray(Counter) = PriceArray(Counter)
    Next Counter
    
    For Counter = 0 To Total - 1
        VolumeSortArray(Counter) = VolumeArray(Counter)
    Next Counter

Answer 3

    
'冒泡排序
    i = 1
    Done = False
    While ((i < CNum) And (Not Done))
        Done = True
        For j = 1 To CNum - i
            If CompanySortArray(j - 1) > CompanySortArray(j) Then
                temp = CompanySortArray(j - 1)
                CompanySortArray(j - 1) = CompanySortArray(j)
                CompanySortArray(j) = temp
                Done = False
            End If
        Next j
        i = i + 1
    Wend'唯一化
    Counter = 0
    For Each Element In CompanySortArray()
     If Counter = 0 Then
         CompanyUniqeArray(Counter) = Element
         Counter = Counter + 1
     Else
         If CompanyUniqeArray(Counter - 1) <> Element Then
             CompanyUniqeArray(Counter) = Element
             Counter = Counter + 1
         End If
     End If
    Next
    TStore = Counter
    For Counter = 1 To TStore - 1
        Worksheets("Sheet1").Cells(Counter + 1, 9).Value = CompanyUniqeArray(Counter - 1)
    Next Counter
    
'冒泡排序
    i = 1
    Done = False
    While ((i < PNum) And (Not Done))
        Done = True
        For j = 1 To PNum - i
            If PriceSortArray(j - 1) > PriceSortArray(j) Then
                temp = PriceSortArray(j - 1)
                PriceSortArray(j - 1) = PriceSortArray(j)
                PriceSortArray(j) = temp
                Done = False
            End If
        Next j
        i = i + 1
    Wend
'唯一化
    Counter = 0
    For Each Element In PriceSortArray()
     If Counter = 0 Then
         PriceUniqeArray(Counter) = Element
         Counter = Counter + 1
     Else
         If PriceUniqeArray(Counter - 1) <> Element Then
             PriceUniqeArray(Counter) = Element
             Counter = Counter + 1
         End If
     End If
    Next
    
    TStore = Counter
    For Counter = 1 To TStore - 1
        Worksheets("Sheet1").Cells(Counter + 1, 10).Value = PriceUniqeArray(Counter - 1)
    Next Counter
        
    i = 0
    While (PriceUniqeArray(i) > 0)
        j = 0
        VolumeSum = 0
        While (CompanyUniqeArray(j) > 0)
            temp = 0
            For Counter = 1 To Total - 1
                If (CompanyArray(Counter - 1) = CompanyUniqeArray(j)) And (PriceArray(Counter - 1) >= PriceUniqeArray(i)) Then
                    If (VolumeSortArray(Counter - 1) > temp) Then temp = VolumeSortArray(Counter - 1)
                End If
            Next Counter
            
            Worksheets("Sheet1").Cells(i + 2, 13 + 2 * j).Value = CompanyUniqeArray(j)
            Worksheets("Sheet1").Cells(i + 2, 13 + 2 * j + 1).Value = temp
            VolumeSum = VolumeSum + temp
            j = j + 1
         Wend
         Worksheets("Sheet1").Cells(i + 2, 11).Value = PriceUniqeArray(i)
         Worksheets("Sheet1").Cells(i + 2, 12).Value = VolumeSum
         i = i + 1
    Wend
End SubPrivate Sub CommandButton2_Click()
'取有效纪录数
    Total = Worksheets("Sheet1").UsedRange.Rows.Count
    For i = 6 To 6 + 10 + 2 * Total
        Worksheets("Sheet1").Columns(i).ClearContents
    Next i
End Sub