Блог

Главная - Вопросы по программированию - Ошибка, определяемая приложением или объектом (VBA — Visual Basic для приложений)

Ошибка, определяемая приложением или объектом (VBA — Visual Basic для приложений)

#excel #vba

Вопрос:

Итак, вот в чем дело. Я пытаюсь «сопоставить» столбец на определенном листе (называемом Метриками) таким образом, чтобы выбрать значения, близкие к значениям на другом листе (называемом статистическими данными), и преобразовать их в эквивалент в столбце G рядом с этим.

Моя проблема в том, что я получаю ошибку «Ошибка, определенная приложением или объектом (VBA-Visual Basic для приложений)», и я не знаю, почему!

 Sub Button1_Click()

Dim limit As Integer
limit = 9999

Dim position As Integer
position = 0

Dim differenceA As String
Dim N1 As Integer
Dim differenceB As String
Dim N2 As Integer

Dim ref As String
ref = ""


For i = 1 To Rows.Count

       If Not Cells(i, 11).Value = "-" Then
        
           For j = 2 To 37
            
                If IsNumeric(Sheets("Metrics").Cells(i, "K").Value) And IsNumeric(Sheets("StaticData").Cells(j, "H").Value) Then
            
                    differenceA = Sheets("Metrics").Cells(i, "K").Value
                    N1 = CInt(differenceA)
                    differenceB = Sheets("StaticData").Cells(j, "H").Value
                    N1 = CInt(differenceA)
                    
                    If Abs(N1 - N2) < limit Then
                   
                        limit = Abs(N1 - N2)
                        position = j
                
                    End If
              
                End If
            
            Next j
          
            limit = 9999
            Sheets("Metrics").Activate
            ActiveSheet.Cells(i, "K").Value = CStr(Sheets("StaticData").Cells(position, "G").Value)
  
        End If

    Next i
    
End Sub

Среда разработки сообщает мне, что моя ошибка в строке:

 ActiveSheet.Cells(i, "K").Value = CStr(Sheets("StaticData").Cells(position, "G").Value)

Я также пробовал с:

 Sheets("Metrics").Cells(i, "K").Value = CStr(Sheets("StaticData").Cells(position, "G").Value)

Но я продолжал получать ту же ошибку… А также пытался без приведения к струнам, но это тот же самый случай

Спасибо!

С уважением.

Комментарии:

1. Эта ошибка может означать, что некоторые библиотеки VBA не установлены в вашей панели Excel VBA. Кроме того, в вашем коде отсутствует: Dim i Такой же длинный, j Такой же Длинный в самом начале, я думаю

2. Знаете ли вы, что пытаетесь перезаписать числовые значения в столбце K » из Metrics «тем, что «найдено» в столбце G «из StaticData «, преобразованном в строку? Обычно результат записывается в другой столбец («столбец назначения»), чем «столбец поиска» ( K ), Metrics например, в столбце L т. е. ActiveSheet.Cells(i, "L").value = ... . Пожалуйста, уточните.

3. Вы получите эту ошибку, если позиция = 0

4. Второй N1 = CInt(differenceA) , вероятно, должен быть N2 = CInt(differenceB)

Ответ №1:

Поиск VBA с одним или двумя поворотами

  • Просматривает ячейки столбца K на листе ( Metrics ) и находит ячейку в столбце ( H ) другого листа ( StaticData ), содержащую значение, наиболее близкое к значению в текущей ячейке первого листа ( StaticData ). Заменяет значение на первом листе ( Metrics ) значением, найденным в столбце ( G ) другого листа ( StaticData ), в той же строке, что и строка ячейки (в столбце H ), содержащая ближайшее значение, ранее найденное на другом листе ( StaticData ).
 Option Explicit

Sub Button1_Click()

    Const sfRow As Long = 2 ' Source First Row
    Const dfRow As Long = 2 ' Destination First Row
    Const DiffMax As Double = 1000000
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("StaticData")
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "H").End(xlUp).Row
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Metrics")
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "K").End(xlUp).Row
    
    Dim slValue As Variant ' Source Lookup Value
    Dim sr As Long ' Source Row Counter
    Dim sRow As Long ' Source Row
    Dim dlValue As Variant ' Destination Lookup Value
    Dim dr As Long ' Destination Row Counter
    Dim DiffFinal As Double
    Dim DiffCurrent As Double
    For dr = dfRow To dlRow
        dlValue = dws.Cells(dr, "K").Value
        DiffFinal = DiffMax
        sRow = 0
        If IsNumeric(dlValue) Then
            For sr = sfRow To slRow
                slValue = sws.Cells(sr, "H").Value
                If IsNumeric(slValue) Then
                    DiffCurrent = Abs(dlValue - slValue)
                    If DiffCurrent < DiffFinal Then
                        DiffFinal = DiffCurrent
                        sRow = sr
                    End If
                End If
            Next sr
            If sRow > 0 Then
                ' Change the 'K' to write to another column.
                dws.Cells(dr, "K").Value = CStr(sws.Cells(sRow, "G").Value)
            'Else ' no numeric value in cells of Source Lookup Range
            End If
        'Else ' not a numeric value in Destination Lookup Cell
        End If

    Next dr
    
End Sub
Метки: ,