VBA在保存数据后，会跳行或覆盖，实现能按照行顺序填充行

woshikm114 · 发表于 2024-1-23 23:13

本帖最后由 woshikm114 于 2024-1-23 23:17 编辑

我在使用VBA登记保存数据时，
数据少的时候会跳行，
到数据多的时候会被覆盖，
数据少就需要调整X值，请各位老师帮忙看一下。

Dim arr, X%, Y%
With Sheets("处方药登记") '数据所在工作表
X = Application.CountA(.Range("A1:A65533")) + 6
If Range("C16") <> "" Then
arr = Array([D3].Value, [G3].Value, [D16].Value, [F16].Value, [G16].Value, [H16].Value, [D7].Value, [F7].Value, [H7].Value, [J7].Value, [D11].Value, [G22].Value, [L22].Value, "")
.Cells(X + 1, 1).Resize(1, 14) = arr '
End If
If Range("C17") <> "" Then
arr = Array([D3].Value, [G3].Value, [D17].Value, [F17].Value, [G17].Value, [H17].Value, "", "", "", "", "", [G22].Value, [L22].Value, , "")
.Cells(X + 2, 1).Resize(1, 14) = arr
End If
If Range("C18") <> "" Then
arr = Array([D3].Value, [G3].Value, [D18].Value, [F18].Value, [G18].Value, [H18].Value, "", "", "", "", "", [G22].Value, [L22].Value, , "")
.Cells(X + 3, 1).Resize(1, 14) = arr
End If
If Range("C19") <> "" Then
arr = Array([D3].Value, [G3].Value, [D19].Value, [F19].Value, [G19].Value, [H19].Value, "", "", "", "", "", [G22].Value, [L22].Value, , "")
.Cells(X + 4, 1).Resize(1, 14) = arr
End If
If Range("C20") <> "" Then
arr = Array([D3].Value, [G3].Value, [D20].Value, [F20].Value, [G20].Value, [H20].Value, "", "", "", "", "", [G22].Value, [L22].Value, , "")
.Cells(X + 5, 1).Resize(1, 14) = arr
End If
End With
End Sub

复制代码

X = Application.CountA(.Range("A1:A65533")) + 6 每国一段时间就要调整这个值

<img src="https://club.excelhome.net/forum.php?mod=image&aid=2977548&size=300x300&key=504bdd979e26650d&nocache=yes&type=fixnone" border="0" aid="attachimg_2977548" width="300" alt="">

复制代码

ykcbf1100 · 发表于 2024-1-24 08:20

上传附件比较容易解决问题。

3190496160 · 发表于 2024-1-24 11:31

生成你的excel附件，要看你的表格结构才知道问题所在

准提部林 · 发表于 2024-1-24 13:52

1) X 不應用 counta, 資料間有空行即不能正確去抓最后非空行, 新資料也會覆旧資料
2) X 只能用"累加1", 而不能用X+2, X+3....., 否則填入的一定會有空白行~~

准提部林 · 发表于 2024-1-24 13:55

X =.Range("A65533")).end(xlup).row

If Range("C16") <> "" Then
         arr = Array([D3], [G3], [D16], [F16], [G16], [H16], [D7], [F7], [H7], [J7], [D11], [G22], [L22], "")
         x = x + 1
         .Cells(X , 1).Resize(1, 14) = arr
      End If

woshikm114 · 发表于 2024-1-25 23:22

准提部林发表于 2024-1-24 13:55
X =.Range("A65533")).end(xlup).row

If Range("C16") "" Then

非常感谢，老师指点，按照你修改的向下寻找空白，暂时可以使用，但是不用X+1,X+2 X+3 X+4等
不能实现同时保存5组数据，单纯的使用X=X+1，就出现被覆盖，只保存1组数据。

Dim arr, X%, Y%
With Sheets("处方药登记") '数据所在工作表
X = .Range("A65533").End(xlUp).Row
If Range("C16") <> "" Then
arr = Array([D3], [G3], [D16], [F16], [G16], [H16], [D7], [F7], [H7], [J7], [D11], [G22], [L22], "") 'arr=对应单元格的值
.Cells(X + 1, 1).Resize(1, 14) = arr
End If
If Range("C17") <> "" Then
arr = Array([D3], [G3], [D17], [F17], [G17], [H17], [D7], [F7], [H7], [J7], [D11], [G22], [L22], , "") 'arr=对应单元格的值，当单元格值为空时用""表示
.Cells(X + 2, 1).Resize(1, 14) = arr
End If
If Range("C18") <> "" Then
arr = Array([D3], [G3], [D18], [F18], [G18], [H18], [D7], [F7], [H7], [J7], [D11], [G22], [L22], , "") 'arr=对应单元格的值，当单元格值为空时用""表示
.Cells(X + 3, 1).Resize(1, 14) = arr
End If
If Range("C19") <> "" Then
arr = Array([D3], [G3], [D19], [F19], [G19], [H19], [D7], [F7], [H7], [J7], [D11], [G22], [L22], , "")
.Cells(X + 4, 1).Resize(1, 14) = arr
End If
If Range("C20") <> "" Then
arr = Array([D3], [G3], [D20], [F20], [G20], [H20], [D7], [F7], [H7], [J7], [D11], [G22], [L22], , "")
.Cells(X + 5, 1).Resize(1, 14) = arr
End If

复制代码

我修改了X = Application.CountA(.Range("A1:A65533")) + 6,
改成你发的

准提部林 · 发表于 2024-1-29 16:23

woshikm114 发表于 2024-1-25 23:22
非常感谢，老师指点，按照你修改的向下寻找空白，暂时可以使用，但是不用X+1,X+2 X+3 X+4等
不能实现同 ...

那5個條件若有其中一個不符合, 就有產生一個空白行,
下次再用CONTA, 也會少算了一行, 新資料會覆盖旧資料~~

准提部林 · 发表于 2024-1-29 16:24

woshikm114 发表于 2024-1-25 23:22
非常感谢，老师指点，按照你修改的向下寻找空白，暂时可以使用，但是不用X+1,X+2 X+3 X+4等
不能实现同 ...

那5個條件若有其中一個不符合, 就有產生一個空白行,
下次再用CONTA, 也會少算了一行, 新資料會覆盖旧資料~~

gwjkkkkk · 发表于 2024-1-29 18:36

代码看了头晕。。。

		自动登录	找回密码
密码			免费注册

[求助] VBA在保存数据后，会跳行或覆盖，实现能按照行顺序填充行