2016-03-15 1 views
1

Цель этого макроса - скопировать данные из многих входных листов в лист« Основание »основной/основной книги под названием« Компенсация test5 "на основе двух критериев. Макрос должен: 1) проверить, есть ли входной лист в тот же месяц, что и основная книга. Если это так, 2) он должен скопировать соответствующие данные для соответствующих маршрутов. В настоящее время я получаюПолучение «ошибки времени выполнения» 13: Тип несоответствия «-error при сравнении двух ячеек

Run-time error '13': Type mismatch

в строке 58 (комментарий с заглавной буквы в коде). Что здесь не так?

Я загрузил и привел пример основной книги и примера одной из входных книг. У ячейки даты (ячейка B9) входных книг обычно есть месяц, за которым следуют «-» и год, fx «Февраль-2016». Я раскалываю его в строке 58, чтобы сделать его сопоставимым с месяцами в первом ряду листа «Основа» в основной книге.

enter image description here

Sub combineall() 

    Application.EnableEvents = False 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.Calculation = xlCalculationManual 

    Call lista 
    Call CopyLookup 

    Application.CutCopyMode = False 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 
    Application.EnableEvents = True 

    Workbooks("Kompensation test5").Sheets("List").Delete 
    Workbooks("Kompensation test5").Sheets("Basis").Activate 

End Sub 


Sub CopyLookup() 
    Dim Path As String 
    Dim Fil As String 
    Dim strName As String 
    Dim wbk_main As Workbook, wbk_input As Workbook 
    Dim ws_main As Worksheet, ws_input As Worksheet 
    Dim rng_main As Range, rng_main_date As Range, rng_input As Range, rng_input_date As Range 
    Dim c_main As Range, c_main_date As Range, c_input As Range 
    i = 2 

    While Workbooks("Kompensation test5").Sheets("List").Cells(i, 1) <> "" 
    t = Workbooks("Kompensation test5").Sheets("List").Cells(i, 1) 

    Set wbk_main = ActiveWorkbook 
    Path = "I:\folderpath" & t 

    q = 1 
    'Start outer loop 
    Do While q <> "" 

     Set wbk_input = Workbooks.Open(Path) 
     Set ws_input = wbk_input.Sheets(1) 

     Set rng_main_date = ThisWorkbook.Sheets("Basis").Range("1:1") 
     Set rng_input_date = ws_input.Range("B9") 

     Set rng_input = ws_input.Range("R10:AL10") 

     For Each c_main_date In rng_main_date 
      If c_main_date.Value <> "" Then 
       For Each c_input In rng_input_date 
        If c_input.Value <> "" Then 
         For x = 1 To 100 
         If InStr(Workbooks("Kompensation test5").Sheets("Basis").Cells(1, x), Split(Replace(Workbooks(ws_input).Range(rng_input_date).Value, "-", " "), " ")) > 0 Then 'ERROR HERE! 
          k = x 
         End If 
         Next x 
         Workbooks("Kompensation test5").Sheets("Basis").Range(Cells(4, k - 1), Cells(19, k - 1)).Select 
        End If 
       Next c_input 
      End If 
     Next c_main_date 

     Set rng_main = Workbooks("Kompensation test5").Sheets("Basis").Range(Cells(4, k - 1), Cells(19, k - 1)) 

     'Split cell if containing many values 
     ws_input.Range("B10").Select 
     Selection.TextToColumns Destination:=Range("R10"), DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
     Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ 
     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ 
     Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _ 
     TrailingMinusNumbers:=True 

     'Loop through each cell in col I in sheet 2: 
     For Each c_main In rng_main 
      If c_main.Value <> "" Then 
       For Each c_input In rng_input 
        If c_input.Value = c_main.Value Then 
         c_main.Offset(0, 3).Value = wbk_input.Sheets(1).Range("F13").Value 
         q = "" 
         'Move on to next cell in sheet 2: 
         Exit For '(exits the "For Each c_input In rng_input" loop) 
        End If 
       Next c_input 
      End If 
     Next c_main 

     rng_input.Delete 
     wbk_input.Close False 

    Loop 

    i = i + 1 
    Wend 

End Sub 

Sub lista() 
    Dim objFSO As Object 
    Dim objFolder As Object 
    Dim objFile As Object 
    Dim ws As Worksheet 

    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set ws = Worksheets.Add 
    With ActiveSheet 
    .Name = "List" 
    End With 

    fldrpath = "I:\folderpath" 
    Set objFolder = objFSO.GetFolder(fldrpath) 
    ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & "are:" 

    For Each objFile In objFolder.Files 
     ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name 
    Next 

    Set objFolder = Nothing 
    Set objFile = Nothing 
    Set objFSO = Nothing 
End Sub 

ответ

1

Вы забыли сослаться на лист в книге

Workbooks(ws_input).Range(rng_input_date).Value 

Должно быть

Workbooks(ws_input).Sheets("SHEETNAME").Range(rng_input_date).Value 

И просто чтобы убедиться:

Workbooks("Kompensation test5").Sheets("Basis").Cells(1, x).Value 

Вместо

Workbooks("Kompensation test5").Sheets("Basis").Cells(1, x) 

И если это все еще не работает, это потому, что вы сравниваете значение диапазона до значения ячейки, так изменить

Workbooks(ws_input).Sheets("SHEETNAME").Range(rng_input_date).Value 

Для

Workbooks(ws_input).Sheets("SHEETNAME").Cells(9,2).Value 'If your Date is in Cell B9 
+0

Делает смысл :) Пробовал оба подхода. Оба производили ту же ошибку, что и раньше (в той же строке). – Saud

+1

Затем разделите каждый шаг строки ошибки на одну строку и попытайтесь выяснить, где произошла ошибка. – gizlmo

1

Вы должны использовать .Value после Cells(1, x)

Также смотрите следующее:

При обращении непосредственно к адресу WorkBook Вам необходимо указать расширение. Поэтому вам нужно добавить расширение для файла «Kompensation test5», чтобы сделать его «Kompensation test5.xls» или любым расширением.

При желании значение из Range и вы установили Range уже, вам нужно всего лишь использовать имя Range и в .Value так и для второй линии нужно просто rng_input_date.Value

Так линия 58 должна быть что-то вроде этого, предполагая, что «Kompensation test5» расширение файла .xls

If InStr(Workbooks("Kompensation test5.xlsm").Sheets("Basis").Cells(1, x).Value, Workbooks(ws_input).Range(rng_input_date).Value) > 0 Then 'ERROR HERE! 
    k = x 
End If 

Но помните, что функция Split создает Array поэтому будет несоответствие типа.

Вы действительно не сравниваете данные в «Kompensation test5» и «Mappe1» правильно.Пожалуйста, проверьте исходные данные и сообщите нам данные для сравниваемых ячеек, это данные просто на слово или 2015/02/19, из которых отображается только месяц.

Ваш For Loop также не будет работать должным образом, потому что ваши имена месяц в «Kompensation test5» лист только в каждом 7-й колонке, так что вам нужно использовать

For x = 1 To 100 Step 7

Это будет выбрать ячейки в который отображается в диалоговом окне «Месяц» при использовании диапазона объединенных ячеек.

+0

Пробовал добавлять .value, но я получил ту же ошибку в той же строке. – Saud

+1

@Saud посмотреть сейчас, в этой строке все еще много, что неверно. Итак, предоставьте следующее: > Фактические необработанные данные в ячейках B9 Mappe1 > Фактические исходные данные в строке 1 (Месячные значения) "Kompensation test5" Это поможет с правильной коррекцией месяца. –

+0

Я добавил расширение, сослался на диапазон правильно и принял во внимание, что месяц в основной книге находится в каждом седьмом столбце. Данные в ячейке B9 входных книг являются словом/строкой. Примером может служить «январь - 2016 год», который по сравнению с «январем» следует сравнить с основной книгой. Вот почему я использую функцию split. Название месяца всегда сопровождается годом. – Saud

Смежные вопросы