主页 / 问题 / 1085277
Accepted
Nikita Shuvalov
Asked:2020-02-20 22:17:29 +0000 UTC2020-02-20 22:17:29 +0000 UTC

宏选择另一个范围内的单元格

  • 772

有一个文件，需要根据列和行在第二张纸上选择一个单元格。工作表 2 上的位置可能不同，但所有内容都仅来自第二张工作表的列表。如何正确注册宏，我试着像这样注册

Lastrow = ThisWorkbook.Sheets("лист1").Cells(Rows.Count, 1).End(xlUp).Row
Lastcolumn = ThisWorkbook.Sheets("лист1").Cells(4, Columns.Count).End(xlToLeft).Column
x = ThisWorkbook.Sheets("лист2").Cells(2, 1)
Do While y = Lastcolumn
   For Z = 1 To Lastrow
   For y = 1 To Lastcolumn
        If ThisWorkbook.Sheets("лист1").Cells(Z, 1) = x And ThisWorkbook.Sheets("лист1").Cells(Z, y) > 0 And IsNumeric(ThisWorkbook.Sheets("лист1").Cells(Z, y)) Then
        ThisWorkbook.Sheets("лист2").Cells(5, y).Interior.Color = RGB(240, 150, 0)
         y = y + 1
           Exit For
        End If
    Next y
    Next

但这不起作用。

图片中的一个例子。][一]

2

您只需要更改单元格的格式，因此可能还有公式

Ps 有一个解决方案，但是在将其转换为工作表单时我不明白，这太多了，但是

Sub Main()
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
Dim y As Long
Dim x As Integer
Dim a As Variant

With Sheets("Лист2")
    a = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    For y = 2 To UBound(a, 1)
        Set d.Item(a(y, 1)) = CreateObject("Scripting.Dictionary")
    Next
End With

With Sheets("Лист1")
    y = .Cells(.Rows.Count, 1).End(xlUp).Row
    x = .Cells(1, .Columns.Count).End(xlToLeft).Column
    a = .Range(.Cells(1, 1), .Cells(y, x))
    Dim v As Variant
    For Each v In d.Keys
        If WorksheetFunction.CountIfs(.Columns(1), v) > 0 Then
            y = WorksheetFunction.Match(v, .Columns(1), 0)
            For x = 2 To UBound(a, 2)
                If Not IsEmpty(a(y, x)) Then
                    d.Item(v).Item(x) = 0
                End If
            Next
        End If
    Next
End With

Dim r As Range
With Sheets("Лист2")
    For y = 1 To d.Count
        For Each v In d.Items()(y - 1).Keys
            If r Is Nothing Then
                Set r = Cells(y + 1, v)
            Else
                Set r = Union(r, Cells(y + 1, v))
            End If
        Next
    Next

    .Cells.Interior.Pattern = xlNone
    If Not r Is Nothing Then
        r.Interior.Color = 65535
    End If
End With

End Sub 是否可以编写代码以仅垂直和水平搜索匹配项，并选择确切需要哪一列或哪一行？

excel

1 个回答

  1. Best Answer

    这是绘制表格的宏示例：

    Sub x()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = ThisWorkbook.Sheets("Лист1")
Set sh2 = ThisWorkbook.Sheets("Лист2")
Dim tmp1()
' Копируем данные с листа в массив для ускорения обработки '
tmp1 = sh1.UsedRange.Value
tmp2 = sh2.UsedRange.Value
Dim i As Integer, j As Integer, k As Integer
' Перебираем строки листа назначения '
For i = LBound(tmp2) + 1 To UBound(tmp2)
    ' Перебираем исходные данные, ищем строку с тем же продуктом '
    For j = LBound(tmp1) + 1 To UBound(tmp1)
        If tmp1(j, 1) = tmp2(i, 1) Then
            ' Если нашли - запоминаем номер '
            k = j
            Exit For
        End If
    Next j
    ' Сканируем строку исходных данных на предмет наличия значения '
    For j = LBound(tmp1, 2) + 1 To UBound(tmp1, 2)
        If Not IsEmpty(tmp1(k, j)) Then
            ' Если нашли - красим соотв. ячейку '
            sh2.Cells(i, j).Interior.Color = vbYellow
        End If
    Next j
Next i
End Sub

    在水平方向上，比较是在循环中执行的。通过索引沿垂直方向进行了愚蠢的匹配，但您也可以组织搜索（添加另一个循环 - 我太懒了）。

    数组更容易使用，最重要的是，它比单元更快。而且桌子越胖，差别就越大。您也可以ScreenUpdate=False添加，这是一个额外的加速。

    • 0

相关问题