Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
330 views
in Technique[技术] by (71.8m points)

excel - Value of cell that depends on another dynamic cell within a range

Range A1:A5 is filled with dynamic data, though the data is limited to 5 values, the sequence could differ. It is also possible that only 4 or less is presented. The values are also unique.

Column B's value will depend on Column A.

Example:

   A     B
1 item2  USD18
2 item1  USD15
3 item3  USD4
4 item5  USD23
5 item4  USD11

How do I accomplish this on VBA?

question from:https://stackoverflow.com/questions/65661899/value-of-cell-that-depends-on-another-dynamic-cell-within-a-range

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

Quite tricky. Please try this code after adjusting the items marked "change to suit".

Sub SetSequence()
    ' 156

    Const DataClm   As Long = 2             ' change to suit (2 = column B)
    Const ItemClm   As Long = 1             ' change to suit (1 = column A)
    
    Dim Wb          As Workbook
    Dim Ws          As Worksheet
    Dim DataRng     As Range                ' sorted given data (column B in your example)
    Dim Results     As Variant              ' results: sorted 1 to 5
    Dim TmpClm      As Long                 ' a column temporarily used by this macro
    Dim Tmp         As String               ' working string
    Dim R           As Long                 ' oop counter: rows
    Dim i           As Long                 ' index of Results
    
    Results = Array("Item1", "Item2", "Item3", _
                    "Item4", "Item5")       ' modify list items as required (sorted!)
    Set Wb = ThisWorkbook                   ' modify as needed
    Set Ws = Wb.Worksheets("Sheet1")        ' change to suit
    With Ws
        With .UsedRange
            TmpClm = .Column + .Columns.Count
        End With
        
        ' create a copy of your data (without header) in an unused column
        .Range(.Cells(2, DataClm), .Cells(.Rows.Count, DataClm).End(xlUp)) _
               .Copy .Cells(1, TmpClm)
        Set DataRng = .Range(.Cells(1, TmpClm), .Cells(.Rows.Count, TmpClm).End(xlUp))
        
        With .Sort.SortFields
            .Clear
            .Add2 Key:=Ws.Cells(1, TmpClm), _
                  SortOn:=xlSortOnValues, _
                  Order:=xlAscending, _
                  DataOption:=xlSortNormal
        End With
        With .Sort
            .SetRange DataRng
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        ' blanks are removed, if any
        Set DataRng = .Range(.Cells(1, TmpClm), .Cells(.Rows.Count, TmpClm).End(xlUp))
        ' start in row 2 of DataClm and look at next 5 cells
        For R = 2 To 6
            ' skip over blanks
            Tmp = .Cells(R, DataClm).Value
            If Len(Trim(Tmp)) Then
                i = WorksheetFunction.Match(Tmp, DataRng, 0)
                .Cells(R, ItemClm).Value = Results(i - 1)
            End If
        Next R
        .Columns(TmpClm).ClearContents
    End With
End Sub

The code creates a sorted copy of the items you have in column B and draws the output in column A from the similarly sorted list of results. Blanks are ignored. But if there is one blank in the input list (column B) there will be only 4 items in the sorted input list and therefore none of the items can be assigned "Item 5" in column A.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...