我需要一些帮助:我有一个看起来像那样的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
答案 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