Показывать содержимое других ячеек с тем же текстом перед символом "-"

Question

У меня два листа.

ЛИСТЫ 1 содержат столбец с некоторыми SKU'ами с этой структурой:

GM1012-01

GM1012-04

GM1012-06

9431-01

9431-02

etc..

---

ЛИСТЫ 2 будут содержать эти 2 столбца

GM1012-01     |  GM1012-04,GM1012-06  

GM1012-04     |  GM1012-01,GM1012-06  

GM1012-06     |  GM1012-01,GM1012-04  

9431-01       |  9431-02

9431-02       |  9431-01

Что мне нужно сделать, это начать с листа 2. Выполните поиск, если в листе 1 присутствуют sku с тем же кодом перед «-», а затем покажите все они через запятую, за исключением одного в первом столбце.

Уже два часа я пытаюсь это сделать :( спасибо

Answer 1

Если я правильно понимаю, это может помочь вам:

        Option Explicit

    Sub test()

        Dim Lrow1 As Long
        Dim Lrow2 As Long
        Dim str1 As String
        Dim str2 As String
        Dim i As Long
        Dim j As Long
        Dim Counter As Long
        Dim TopNu As Long

            Lrow1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
            Lrow2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row

            Sheet2.Range("B2" & ":B" & Lrow2).Clear

            For i = 2 To Lrow1
                str1 = Left(Sheet1.Cells(i, "A").Value, InStr(Sheet1.Cells(i, "A").Value, "-") - 1)
                For j = 2 To Lrow2
                    str2 = Left(Sheet2.Cells(j, "A").Value, InStr(Sheet2.Cells(j, "A").Value, "-") - 1)
                    If (str1 = str2) And Sheet1.Cells(i, "A").Value <> Sheet2.Cells(j, "A").Value Then
                        If Sheet2.Cells(j, "B").Value = "" Then
                            Sheet2.Cells(j, "B").Value = Sheet1.Cells(i, "A").Value
                        Else
                            Sheet2.Cells(j, "B").Value = Sheet2.Cells(j, "B").Value & "," & Sheet1.Cells(i, "A").Value
                        End If
                        If Sheet2.Cells(j, "B").Value <> "" Then
                            Counter = (Len(Sheet2.Cells(j, "B").Value) - Len(Replace(Sheet2.Cells(j, "B").Value, ",", ""))) / Len(",")
                            If Counter = 0 Then
                                Sheet2.Cells(j, "C").Value = 1
                            Else
                                Sheet2.Cells(j, "C").Value = Counter + 1
                            End If
                        End If
                    End If
                Next j
            Next i
            Lrow2 = Sheet2.Cells(Sheet2.Rows.Count, "B").End(xlUp).Row
            For i = 2 To Lrow2
                If Sheet2.Cells(i, "C").Value <> "" Then
                    TopNu = Sheet2.Cells(i, "C").Value
                    Do Until TopNu = 0
                        If Sheet2.Cells(i, "D").Value = "" Then
                            Sheet2.Cells(i, "D").Value = TopNu
                        Else: Sheet2.Cells(i, "D").Value = Sheet2.Cells(i, "D").Value & "," & TopNu
                        End If
                        TopNu = TopNu - 1
                    Loop

                End If
            Next i
    End Sub

Результаты: Лист1:

Лист2:

Убедитесь, что:

• В Sheet1 у вас есть SKU в столбце A, начиная с A2.
• В Sheet2 у вас есть SKU в столбце A, начиная с A2.

Для более подробных помощников см. Изображения.

Инструкции:

• Откройте Excel и нажмите Первая ALTа затем F11.
• Вставьте и нажмите Модуль.
• Удалите все из модуля, скопируйте, вставьте код и нажмите F5.
• Посетите Excel и просмотрите результаты.