依据公司名称和相应的产品数量值，插入多行空白行

redsunsky

各位大神、大虾好！
      又要麻烦您们帮忙一下。谢谢！
A、B列为引用数据。
我想依C列的公司名称清单，和D列（公司相应的品种数量值）来决定在公司名称下要加插多行空白行。
我自已写的行不通。
Dim i as integer
Dim ii as integer
for i =3 to 18
      if cells(i,"C")<>"" then
             ii=cells(i,"D").value
       Rows(i & ":" & ii).Insert Shift:=xlDown
       end if
next
好像一直只会乱在上面加插，不能对应在A公司下面，或者B公司下面相应插多少行。
再次谢谢各位。

hfwufanhf2006

我看了半天，你是不是只是想在C列和D列插入？如果是，测试下面的代码，如果不是我就没看懂，代码也不能用：
For i = 3 To 1000
    If IsEmpty(Cells(i, 3)) Then
       Exit For
    End If
    Cells(i, "c").Select
    If Cells(i, "C") <> "" Then
        ii = Cells(i, "D")
        Range("c" & i + 1 & ":d" & ii + i).Insert Shift:=xlDown
    End If
    i = i + ii
Next i

另外，这插入的代码是单项一次性的，就是说你插入了空行就变不回来了，先做个备份；

redsunsky1

hfwufanhf2006 发表于 2020-4-2 13:15
我看了半天，你是不是只是想在C列和D列插入？如果是，测试下面的代码，如果不是我就没看懂，代码也不能用： ...

太好啦，谢谢您！您说的正是我想要的。感恩指教，谢谢！

redsunsky

hfwufanhf2006 发表于 2020-4-2 13:15
我看了半天，你是不是只是想在C列和D列插入？如果是，测试下面的代码，如果不是我就没看懂，代码也不能用： ...

老师好，想再请教一下。如果改成这样，是如何实施。我自已试了一下，不知道那里不成了。谢谢指教。
Dim i As Integer
Dim j As Integer
Dim k As Integer
k = 13
For ii = 3 To 7
'        If IsEmpty(Cells(ii, "C")) Then
'           eixt
'         End If
        For i = 3 To 20
            If Cells(j, "C") = Cells(i, "A") Then
             cell(k, "d") = Cells(j, "C")
             cell(k, "e") = Cells(i, "A").Offset(0, 1).Value
            k = k + 1
            End If
        Next
Next


技术请教2.rar (9.15 KB, 下载次数: 3)

2020-4-3 16:38 上传

点击文件名下载附件

hfwufanhf2006

redsunsky 发表于 2020-4-3 16:39
老师好，想再请教一下。如果改成这样，是如何实施。我自已试了一下，不知道那里不成了。谢谢指教。
Dim  ...

1、有变量的错误，比如If Cells(j, "C") = Cells(i, "A") Then，很明显不存在变量j；
2、有单词拼写错误， cell(k, "d")应该是cells(k,"d");
3、offset不需要，直接写单元格；
4、修改后的代码：
k = 14
For ii = 3 To [c10000].End(3).Row
    For i = 3 To [a10000].End(3).Row
        If Cells(i, "a") = Cells(ii, "c") Then
           Cells(k, "d") = Cells(i, "a")
           Cells(k, "e") = Cells(i, "b")
           k = k + 1
        End If
    Next
Next

redsunsky

hfwufanhf2006 发表于 2020-4-3 18:11
1、有变量的错误，比如If Cells(j, "C") = Cells(i, "A") Then，很明显不存在变量j；
2、有单词拼写错误 ...

老师，为什么我写的J，就不是变量，您换成K就可以？好像都是一样有个字符代替。。

redsunsky

hfwufanhf2006 发表于 2020-4-3 18:11
1、有变量的错误，比如If Cells(j, "C") = Cells(i, "A") Then，很明显不存在变量j；
2、有单词拼写错误 ...

找到原因了，感恩您！

redsunsky

hfwufanhf2006 发表于 2020-4-2 13:15
我看了半天，你是不是只是想在C列和D列插入？如果是，测试下面的代码，如果不是我就没看懂，代码也不能用： ...

老师这个今晚我试改动一点点。遇到一些想不到的问题，又发过来，请老师帮帮眼，谢谢！不知道是 不我罗辑上又不动。所以跳不过去。Sub test()
For i = 3 To 1000
    If IsEmpty(Cells(i, 3)) Then
       Exit For
    End If
    Cells(i, "c").Select
    If Cells(i, "C") <> "" Then
        ii = Cells(i, "D")
        If ii >= 2 Then
        Range("c" & i + 1 & ":d" & ii + i - 1).Insert Shift:=xlDown
           i = i + ii - 1
        End If
        If ii = 1 Then
           i = i + ii
        End If
    End If

Next i
End Sub
碰见的问题.rar (12.84 KB, 下载次数: 4)

2020-4-3 20:15 上传

点击文件名下载附件

shuidisyy

1. Sub test()
   
2.     Dim i As Integer, irow As Integer, n As Integer
   
3.     irow = Range("d" & Rows.Count).End(xlUp).Row
   
4.     For i = irow To 3 Step -1
   
5.         n = Range("d" & i - 1).Value - 1
   
6.         If n > 0 Then
   
7.             Range("d" & i).EntireRow.Resize(n).Insert
   
8.         End If
   
9.     Next i
   
10. End Sub
    

复制代码

hfwufanhf2006

redsunsky 发表于 2020-4-3 20:16
老师这个今晚我试改动一点点。遇到一些想不到的问题，又发过来，请老师帮帮眼，谢谢！不知道是 不我罗辑 ...

1、你代码明确排除了1的可能性：
        If ii >= 2 Then
        Range("c" & i + 1 & ":d" & ii + i - 1).Insert Shift:=xlDown

2、这个地方我也看不明白：
        If ii = 1 Then
           i = i + ii
        End If

        除非有明确目的，一般不要对特定的数字做限制；

      与我原来的比较：
      If Cells(i, "C") <> "" Then
          ii = Cells(i, "D")
          Range("c" & i + 1 & ":d" & ii + i).Insert Shift:=xlDown
      End If
      i = i + ii
      原来的代码只要数字不是零，都适用；

3、你下面一楼又贴了一段代码，我不知道是什么意思？