Проверьте, есть ли значение в массиве, затем выполните

Question

У меня есть следующие данные:

Проблема, которую я пытаюсь решить, заключается в том, что иногда Column H (Place) and Column I (Country) switch places (ex: lines 9,10,11). То, что я хотел бы сделать, это:

1. Сначала проверьте, если год в течение последних 3 лет (мне не нужно исправлять данные старше, чем это).
2. Загрузить диапазон значений в массив.
3. Сравните, если значения в столбце H находятся в массиве.
4. Если нет, переключите значения между столбцами. Я сделал это, просто скопировав и вставив.

Я застрял в этой точке. Извините, если это некрасиво, впервые работая с массивами

Список, который я загружаю в массив, находится в одной рабочей книге, а данные - в другой рабочей. Это работает или они должны быть в одной книге?

Sub check_data()
        Sheets("list").Activate 'this workbook

Dim DirArray As Variant

DirArray = Range("a1:a18").Value 'loads the range into an array

mypath = "//mynetworkpath/" 'sets the path

file = Dir(mypath & "filename.csv") 'indicates name of the file

Workbooks.Open (mypath & file) 'opens the file

Dim lastrow As Long

lastrow = Cells(Rows.Count, 2).End(xlUp).Row 'sorting by year

Range("A2:K" & lastrow).Sort key1:=Range("B2:B" & lastrow), _
   order1:=xlDescending, Header:=xlNo

 end_year = Format(Now, "yyyy") - 3 ' last 3 years

x = 2 'starts from second row

Do Until Cells(x, 2) = end_year  'cells(row,col)

For y = LBound(DirArray) To UBound(DirArray)

    If Sheet1.Cells(x, 8) = DirArray(y) Then

    Range("H" & x).Select
    Selection.Copy
    Range("M" & x).Select
    ActiveSheet.Paste
    Range("I" & x).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H" & x).Select
    ActiveSheet.Paste
    Range("M" & x).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("I" & x).Select
    ActiveSheet.Paste

        Exit For
    End If

Next
   x = x + 1

 Loop

  ActiveWorkbook.Save

 ActiveWorkbook.Close True


End Sub

Любое руководство полезно!

Спасибо

Answer 1

Вы можете оставить список на рабочем листе и использовать совпадение для проверки значений:

Sub check_data()

    Const FPATH As String = "\\mynetworkpath\" 'use Const for fixed values

    Dim rngVals As Range, wb As Workbook, lastrow As Long
    Dim ws As Worksheet, tmp, file

    Set rngVals = ThisWorkbook.Sheets("list").Range("a1:a18") 'your lookup list

    file = Dir(FPATH & "filename.csv")

    If Len(file) > 0 Then

        Set wb = Workbooks.Open(FPATH & file) 'opens the file
        Set ws = wb.Worksheets(1)

        lastrow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row

        ws.Range("A2:K" & lastrow).Sort key1:=ws.Range("B2:B" & lastrow), _
                  order1:=xlDescending, Header:=xlNo

        end_year = Year(Now) - 3 ' last 3 years

        x = 2 'starts from second row
        Do Until Cells(x, 2) = end_year  'cells(row,col)
            tmp = ws.Cells(x, 8).Value
            'use Match to check the value against the list
            m = Application.Match(tmp, rngVals, 0)
            If Not IsError(m) Then
                'got a match, so swap the values from H and I
                ws.Cells(x, 8).Value = ws.Cells(x, 9).Value
                ws.Cells(x, 9).Value = tmp
            End If
            x = x + 1
        Loop

        wb.Save
        wb.Close
    End If 'got the file

End Sub