2014-12-29 3 views
-2

возникают проблемы при создании макроса, который может выполнять следующее.вырезать/вставлять повторяющиеся значения в нескольких столбцах

Значения в колонке А и С Цифры в колонке B и D

макрокоманда необходимо сравнить данные колонки А и В, против столбца C и D и вырезать/переместить дубликаты данных на Лист2. он должен быть в том же формате, что и в листе 1. значение, цифры, значение, цифры.

в конце я должен быть оставлен со всеми записями в столбцах A: D записей, которые не совпадают и в листе 2 всех записей, которые сделали матч

я пытался играть с кодом я получил от предыдущего вопрос, но не повезло. он, похоже, не хочет искать оба столбца.

example: 
Sheet 1 before start 
Column A Column B Column C Column D 
20   10   10   20 
10   7   17   10 
10   20   8   7 
10   7   10   7 

then afterwards: 
Sheet 1: 
Column A Column B Column C Column D 
20   10  17   10 
10   7   8   7 

Sheet 2: 
Column A Column B Column C Column D 
10   7   10   20 
10   20   10   7 

моя попытка не проверяет оба столбца, но только один столбец, так как я понятия не имею, как проверить и, затем второй, который копирует информацию из второго столбца листа 2. Если заявление о том, когда для копирования не работает должным образом, и пока нет петли. мои знания по vba очень ограничены

Sub Matchin() 

Dim wsMain As Worksheet, wsOutput As Worksheet 
Dim lRowColA As Long, lRowColB As Long, i As Long, j As Long 
Dim Acell As Range, ColARng As Range, ColBRng As Range 

'~~> Set input Sheet and output sheet 
Set wsMain = ThisWorkbook.Sheets("Balancing") 
Set wsOutput = ThisWorkbook.Sheets("Remove") 

'~~> Start Row in output sheet 
j = 1 

With wsMain 
    '~~> Get last row in Col A & B 
    lRowColA = .Range("A" & .Rows.Count).End(xlUp).Row 
    lRowColB = .Range("C" & .Rows.Count).End(xlUp).Row 

    '~~> Set your actual data range in Col A and B 
    Set ColARng = .Range("A1:A" & lRowColA) 
    Set ColBRng = .Range("C1:C" & lRowColB) 

    '~~> Loop through Col A 
    For i = 1 To lRowColA 
     If Len(Trim(.Range("A" & i).Value)) <> 0 Then 
      '~~> Check if there are duplicates of Col A value in Col B 
      If Application.WorksheetFunction.CountIf(ColBRng, _ 
      .Range("A" & i).Value) > 0 Then 

       '~~> If found write to output sheet 
       wsOutput.Cells(j, 1).Value = .Range("A" & i).Value 
       wsOutput.Cells(j, 3).Value = .Range("A" & i).Value 

       '~~> Find the duplicate value in Col B 
       Set Acell = ColBRng.Find(What:=.Range("A" & i).Value, _ 
       LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _ 
       SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 

       '~~> Clear the duplicate value in Col B 
       Acell.ClearContents 
       '~~> Clear the duplicate value in Col A 
       .Range("A" & i).ClearContents 

       '~~> Set i = 1 to restart loop and increment 
       '~~> the next row for output sheet 
       i = 1: j = j + 1 
      End If 
     End If 
    Next i 

End With 
End Sub 

Sub bit() 

Dim i As Long 
Dim j As Long 
Dim cola As Integer, colb As Integer, rng As Range, n#, b# 

cola = Range("A1:A8000").Count 
colb = Range("B1:B8000").Count 

If cola <> colb Then 

Range("A:A").Select 

Selection.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ 
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ 
    , SearchFormat:=False).Activate 
ActiveCell.Offset(0, 1).Select 
ActiveCell.Copy 
Sheets("Remove").Select 
Range("B:B").Select 
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ 
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ 
    , SearchFormat:=False).Activate 
ActiveCell.PasteSpecial 

Sheets("Balancing").Select 
ActiveCell.Offset(0, -1).Select 
ActiveCell.Resize(1, 2).Select 
Selection.Delete Shift:=xlUp 


End If 

End Sub 

любая помощь будет оценена. спасибо

+0

Возможно, вы уже отправили этот же (аналогичный) вопрос. Отправьте свой текущий код и укажите, что именно в этом коде не работает для вас. – Chrismas007

+0

да вопрос аналогичный, но не тот же, оригинал должен был сравнивать только столбец A снова B, этот, который мне нужен столбец A и B для сравнения с столбцами C и D. будет обновляться текущим кодом. – user1955214

+0

Пожалуйста, разместите некоторые образцы данных, как и в предыдущем вопросе, поэтому мы не тратим время на неправильную интерпретацию того, что вы действительно хотите. –

ответ

1

Решение 1

Вам нужно перебирать колонка А & B и сравните C & D.

Dim wsh As Worksheet 
Dim i As Long, j As Long 
Dim str1 As String, str2 As String 
Set wsh = ThisWorkbook.Worksheets("Sheet1") 

i = 2 
Do While wsh.Range("A" & i) & wsh.Range("B" & i) <>"" 
    str1 = wsh.Range("A" & i) & wshRange("B" & i) 
    j = i 
    Do While wsh.Range("C" & j) & wsh.Range("D" & j) <>"" 
     str2 = wsh.Range("C" & j) & wsh.Range("D" & j) 
     If str1 = str2 Then 
      'your logic here 
     End If 
     j = j+1 
    Loop 
    i = i+1 
Loop 

Примечание: Это очень медленно. Я решил показать это, чтобы обеспечить базовое сравнение (по каждому из них).

Решение 2

Раствор 2 бит complecated, если вы не имеете базовые знания о SQL и ADO. Использование команды так:

SELECT A, B 
FROM [Sheet1$] 
WHERE ((A NOT IN(SELECT C AS A FROM [Sheet1$])) AND (B NOT IN (SELECT D AS B FROM [Sheet1$]))) 

вы можете получить записи, которые не соответствуют друг другу.

+0

, просто хочу подтвердить что-то, поскольку я все еще изучаю все это. 1-е решение - в нем указано, что он будет проверять сравнение между столбцами, но он не будет фактическим началом проверки, потому что нет линий, чтобы он мог начать проверку. Я прав в этом? спасибо – user1955214

+0

@ Maciej Los. мои знания vba не так хороши, чтобы понять это. пытался работать с 1 кодом, который вы предоставили, но не получал от него ничего, чтобы работать с ним. любая помощь будет оценена. – user1955214

+0

Что вам нужно знать? Чем я могу вам помочь? –

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