excel 对于y中的每个x，将变量'在中向下移动12个单元格

new9mtju 于 2022-12-14 发布在其他

关注(0)|答案(2)|浏览(142)

我正在编写一个代码，以便在主列表和主列表之间存在匹配信息时，自动在特定单元格中写入信息。
这是将要打印的主列表。x1c 0d1x
这是主列表，是一个组件库。

在我的测试中，我试图比较的信息将是“测试”单元格C3和C180以及“测试2”单元格C15和C191，并且要写入的信息是a183：C189到A6：C12以及A194：C200到A18：C24（如果存在匹配）。
下面是我编写的部分代码：

Sub FR_3_08_Filerie_remplissage_automatique()

'sélection worksheet
Set filerie = ActiveWorkbook.Worksheets("FR-3-08_Filerie")

'tableau liste filerie colonne 1
Dim tableau_fi1 As range
Dim nbrligne_fi1 As Integer
Set tableau_fi1 = filerie.range("c3:c75")
nbrligne_fi1 = tableau_fi1.Rows.Count

'tableau liste filerie colonne 2
Dim tableau_fi2 As range
Dim nbrligne_fi2 As Integer
Set tableau_fi2 = filerie.range("n3:n75")
nbrligne_fi2 = tableau_fi2.Rows.Count

'tableau catalogue carte
Dim tableau_cc As range
Dim nbrligne_cc As Integer
Set tableau_cc = filerie.range("c180:c191")
nbrligne_cc = tableau_cc.Columns.Count

'recherche du duplicata
Dim masterlist As range

'code start

For k = 1 To nbrligne_fi1

    If IsEmpty(tableau_fi1(k, 1)) = False Then 'si cellule vide skip
    
        Set carte_actif = tableau_fi1(k, 1) 'mise en mémoire du composant de la cellule actif du tableau de filerie
        
        For Each masterlist In tableau_cc 'recherche de duplicata dans le catalogue de carte
    
            If carte_actif.Value = masterlist.Value Then 'si il y a duplicata, écriture de information
    
                'mise en mémoire des cellules utilisé dans les 2 tableaux
                Set couleur1 = carte_actif.Offset(3, 0)
                Set couleur2 = carte_actif.Offset(5, 0)
                Set couleur3 = carte_actif.Offset(7, 0)
                Set couleur4 = carte_actif.Offset(9, 0)
                Set mcouleur1 = tableau_cc.Offset(3, 0)
                Set mcouleur2 = tableau_cc.Offset(5, 0)
                Set mcouleur3 = tableau_cc.Offset(7, 0)
                Set mcouleur4 = tableau_cc.Offset(9, 0)
                
                Set deg1 = carte_actif.Offset(3, -1)
                Set deg2 = carte_actif.Offset(5, -1)
                Set deg3 = carte_actif.Offset(7, -1)
                Set deg4 = carte_actif.Offset(9, -1)
                Set mdeg1 = tableau_cc.Offset(3, -1)
                Set mdeg2 = tableau_cc.Offset(5, -1)
                Set mdeg3 = tableau_cc.Offset(7, -1)
                Set mdeg4 = tableau_cc.Offset(9, -1)
                
                Set qty1 = carte_actif.Offset(3, -2)
                Set qty2 = carte_actif.Offset(5, -2)
                Set qty3 = carte_actif.Offset(7, -2)
                Set qty4 = carte_actif.Offset(9, -2)
                Set mqty1 = tableau_cc.Offset(3, -2)
                Set mqty2 = tableau_cc.Offset(5, -2)
                Set mqty3 = tableau_cc.Offset(7, -2)
                Set mqty4 = tableau_cc.Offset(9, -2)
                
                'écriture de l'information dans le tableau couple de serrage
                couleur1.Value = mcouleur1.Value
                couleur2.Value = mcouleur2.Value
                couleur3.Value = mcouleur3.Value
                couleur4.Value = mcouleur4.Value
                
                deg1.Value = mdeg1.Value
                deg2.Value = mdeg2.Value
                deg3.Value = mdeg3.Value
                deg4.Value = mdeg4.Value
                
                qty1.Value = mqty1.Value
                qty2.Value = mqty2.Value
                qty3.Value = mqty3.Value
                qty4.Value = mqty4.Value
                        
            End If
            
        Next masterlist

    End If
    
    k = k + 11
    
Next k

End Sub

我试图移动的变量是For Each masterlist In tableau_cc中的“masterlist "，每个循环向下移动11个单元格，这将在组件的映像库中从test移动到test 2。否则，代码将尝试验证2之间的每个单元格，这将花费更多的时间完成代码。
我尝试了类似masterlist = masterlist.offset(11, 0)的代码，但它将C191中的信息复制到c180。
我也玩了.end（xdown）通过移动C180和C191到'E''，但我有同样的问题和一个新的1，例如有Set deg1 = carte_actif.Offset(3, -1)打破。-1和任何其他数字的工作，但当我输入-3我得到一个错误，这是我需要的...
在每个循环中将代码12单元格中的“masterlist”向下移动的解决方案是什么？
编辑：
所写的范围是为了测试目的，因为该范围将随着我在列表中添加更多组件而增长。目前它是“C180：C279”，但将来可能会达到C400。这就是我试图在每个循环中将变量“masterlist”向下移动11行的原因。
目前我正在使用Set tableau_cc = filerie.range("c180, c191, c202, c213, c224, c235, c246, c257, c268, c279")作为一个解决方案，以强制验证整个范围的特定单元insteal。我将不得不添加manualy每个单元，因为我扩展了具有更多组件的主列表。也添加了一个exit for，在信息被传输后，使循环更快

excel

来源：https://stackoverflow.com/questions/74735401/move-the-variable-x-12-cell-down-in-for-each-x-in-y

2条答案

按热度按时间

r3i60tvu1#

未测试但应接近：

Sub FR_3_08_Filerie_remplissage_automatique()

    Dim wb As Workbook, filerie As Worksheet, cModel As Range, i As Long
    Dim model, cMatch As Range, matched As Boolean, rw As Long, col As Long
    
    Set wb = ActiveWorkbook
    Set filerie = ActiveWorkbook.Worksheets("FR-3-08_Filerie")
    
    Set cModel = filerie.Range("C3") 'first model value to search for
    Do
        i = i + 1
        If Len(cModel.Value) > 0 Then            'anything to look for?
            Set cMatch = filerie.Range("C180")   'first cell to match on
            Do While cMatch.Row < 400            'adjust max row as needed
                If cMatch.Value = cModel.Value Then
                    For col = -2 To 0
                        For rw = 2 To 8 Step 2
                            cModel.Offset(rw, col).Value = cMatch.Offset(rw, col).Value
                        Next rw
                    Next col
                End If
                Set cMatch = cMatch.Offset(11)
            Loop
        End If
        
        If i Mod 2 = 1 Then
            Set cModel = cModel.Offset(0, 11)   'move over to the right
        Else
            Set cModel = cModel.Offset(12, -11) 'move down and back to the left
        End If
    
    Loop While cModel.Row < 80
    
End Sub

赞(0）回复(0）举报 2022-12-14

sycxhyv72#

尝试以下操作，检查最后一行的C列测试名称，从C180开始

Option Explicit

Sub copy()
Dim lRow As Long, i, x, dn, rt, y
 
Do While Range("C" & Range("C180").Row + i) <> ""
i = i + 11
Loop

lRow = Range("C" & Range("C180").Row + i).Row - 11 ' the last row with test name

 For x = 180 To lRow Step 11
    If Range("C" & x) = Range("C" & Range("C3").Row + y) Then
        For dn = 3 To 9 Step 2
            For rt = 0 To -2 Step -1
                    Range("C" & Range("C3").Row + y).Offset(dn, rt) = Range("C" & x).Offset(dn, rt)
            Next rt
        Next dn
    End If
y = y + 12
 Next x
 
End Sub

赞(0）回复(0）举报 2022-12-14

我来回答

excel 对于y中的每个x，将变量'在中向下移动12个单元格

2条答案

相关问题

热门标签

最新问答