Excel VBE 迭代 2 个单独的列以在新列中生成结果

Question

我正在尝试从 2 列中检查它们是否符合某些条件，以便在新列中给我一个结果。如果 K 列中的单元格包含数字（或非空），则行很重要。如果 I 列中的单元格（包含文本和/或数字）包含特定数字，例如 70、1、1.5、3 或 300，那么我需要它们各自的结果在新列中为 1、1.5、2 和 4 .

Sub Compute()

Dim conversion As Long
Dim Krng As Range, cell As Range, Irng As Range

‘Krng is column K with only numbers. Only rows with numbers in column K matter

Set Krng = Range(Range("K2"), Range("K2").End(xlDown))

‘Irng is column I with strings with both text and numbers. I need to search if the cells in the column contain specific numbers in its strings to give another number in a different column

Set Irng = Range(Range("I2"), Range("I2").End(xlDown))


Dim i As Long

    Do While Not IsEmpty(Krng)
        For i = 1 To Range("I2").End(xlDown)
            If i Like "70" Then conversion = 1
            Else
                If i Like "1" Then conversion = 1.5
                Else
                    If i Like "1.5" Then conversion = 2
                    Else
                        If i Like "3" Or "300" Then conversion = 4
                        Else: conversion = 1

        Next i
    Loop

Range("N1").Value = conversion

End Sub

干杯！

Answer 1

Option Explicit

Sub convert_K_and_I_data()

    Dim i As Long, ws As Worksheet, lr As Long, v As String
    Dim kRng As Range, iRng As Range, nRng As Range
    Dim kArr As Variant, iArr As Variant, nArr As Variant

    Set ws = Worksheets(1)
    lr = ws.Cells(ws.Rows.Count, 11).End(xlUp).Row  'last row in col K

    Set kRng = ws.Range("K2:K" & lr)    'set ranges
    Set iRng = ws.Range("I2:I" & lr)
    Set nRng = ws.Range("N2:N" & lr)
    nRng.Clear  'clear column N

    kArr = kRng 'move range data to memory arrays
    iArr = iRng
    nArr = nRng

    For i = 1 To lr + 1
        If Len(kRng(i, 1)) > 0 Then
            v = iRng(i, 1)
            Select Case True    'sequence of cases is significant
                Case InStr(v, "1.5") > 0:   nArr(i, 1) = 2
                Case InStr(v, "1") > 0:     nArr(i, 1) = 1.5
                Case InStr(v, "70") > 0:    nArr(i, 1) = 1
                Case InStr(v, "300") > 0:   nArr(i, 1) = 4
                Case InStr(v, "3") > 0:     nArr(i, 1) = 4
            End Select
        End If
    Next
    nRng = nArr 'move N data from memory back to column
End Sub