在行中搜索关键字并获取特定数据

时间:2016-10-27 07:29:19

标签: excel vba excel-vba

我需要一些帮助:我有一个看起来像那样的Excel数据库

ID product    ID article    Value A    Type of value A     Value B    Type of value B

Product 1     Article w     Red        PRODUCT             High       ARTICLE
Product 1     Article x     Red        PRODUCT             Low        ARTICLE
Product 2     Article y     Blue       ARTCILE             Low        PRODUCT
Product 2     Article z     Yellow     ARTICLE             Low        PRODUCT

当ID产品对应时,当值A(或B)相同时,值的类型为" PRODUCT"但是当这些值不相等时,类型是" ARTICLE"。

现在我想将这张桌子改成2张(例如下面的例子)。

Sheet PRODUCT:

ID product   Value A     Value B    

Product1     Red        
Product1     Red
Product2                 Low
Product2                 Low

表格文章:

ID article    Value A    Value B

Article w                High
Article x                Low
Article y     Blue
Article z     Yellow

诅咒,我有2个以上的值。一些帮助将是欣赏。

提前致谢,抱歉我的英语不好。

编辑1

  • 1个产品与1到n篇文章(n可能< 10)
  • 有关
  • 数据从A2开始,带有我的2 ID列(产品ID =全局ID和商品ID =唯一ID
  • 有超过2个值(A到B):它更像是A到Z

1 个答案:

答案 0 :(得分:0)

这是我所拥有的

Public nb_visuel As Integer
Public nb_doc As Integer
Public nb_url As Integer


Sub insert_col_alterné_et_formules()
'--------------------------------------------------------------------------------
'random coments
'--------------------------------------------------------------------------------

'Var pour insertion colonnes.
Dim cible As Integer
Dim colonne As Integer
'Var pour remplissage colonnes.
Dim LastRow As Long
Dim sht As Worksheet
Dim compteur As Integer
Dim col As String
'Initialisation pour remplissage colonnes.
Sheets("Données").Select
Set sht = ThisWorkbook.Worksheets("Données")
LastRow = sht.Range("B1").CurrentRegion.Rows.Count

UF_1.Show 'cible is my number of column I ask to the user
cible = (14 + (nb_visuel * 2) + (nb_doc * 2) + (nb_url * 2)) * 2
Application.ScreenUpdating = False

For colx = 13 To cible Step 2
    Columns(colx).Insert Shift:=xlToRight
Next

'Fill the title.
For colonne = 13 To cible
    Cells(1, colonne).Select
    If ActiveCell.Value = "" Then
        ActiveCell.Value = "Comparaison " & Cells(1, colonne - 1)
    End If
Next

'Insert formulas.
For r = 2 To LastRow
    For c = 13 To cible Step 2
        col = Split(Cells(r, c - 1).Address(True, False), "$")(0)
        If Cells(r, c - 1) = "" Then
            Cells(r, c) = "PRODUIT"
        Else
            Cells(r, c).Formula = "=IF(COUNTIF($C:$C,C" & r & ")=COUNTIFS($C:$C,C" & r & ",$" & col & ":$" & col & "," & col & r & "),""PRODUIT"",""ARTICLE"")"
        End If
    Next
Next

'Copy/paste values.
Range("L2:BZ" & LastRow).Select
Selection.Copy
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Application.CutCopyMode = False
Call traitement_marque 'Insert the fomrula to a particular column.
Application.ScreenUpdating = True
MsgBox "Finish!", 64 + vbYesNo, "Information"
Range("A1").Select

End Sub