怎样将多行多列内容填充到单行多列里面？

woniu3721

请问怎样将编辑页面的内容保存到数据库这个表里面。要求是如果编号是数据库里面有的，就修改数据库里面对应编号的内容，如果编号为空或者是数据库里面没有的，则追加一份新的记录保存到数据库。谢谢！ 编辑并录入数据库.zip (16.18 KB, 下载次数: 16)

2024-5-30 21:39 上传

点击文件名下载附件

cnmlgb9998

你这要VBA 才行。。。。。。。。。。。。。

不规则结构

学几天基础应该会了 ！

woniu3721

cnmlgb9998 发表于 2024-5-30 21:46
你这要VBA 才行。。。。。。。。。。。。。

就是求一个VBA代码

cnmlgb9998

借楼练一下 PQ 。。。。。。。。。。。。。。

Qs18

Sub 保存数据()
Dim arr, j, i, t, s, brr(1 To 12), rng As Range, k
arr = Array(3, 4, 6, 7)
For Each a In arr
    For i = 3 To 7 Step 2
        m = m + 1
        brr(m) = Sheet1.Cells(a, i).Value
    Next
Next
Set rng = Sheet2.Cells.Find(Sheet1.[c3].Value)
If rng Is Nothing Then
    k = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Sheet2.Range("a" & k).Value = k - 1
    Sheet2.Range("b" & k).Resize(1, 12) = brr
    MsgBox "保存完成!"
Else
    k = rng.Row
    Sheet2.Range("b" & k).Resize(1, 12) = brr
    MsgBox "修改成功!"
End If

For Each a In arr
    For i = 3 To 7 Step 2
        
     Sheet1.Cells(a, i).Value = ""
    Next
Next
End Sub

Qs18

试一下。。。。

woniu3721

Qs18 发表于 2024-5-30 22:47
Sub 保存数据()
Dim arr, j, i, t, s, brr(1 To 12), rng As Range, k
arr = Array(3, 4, 6, 7)

效果立竿见影，确实很牛掰！

ykcbf1100

参与一下。。。

可编辑，可新增

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.31
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     b = [{"c3","e3","g3","c4","e4","g4","c6","e6","g6","c7","e7","g7"}]
   
5.     With Sheets("数据库")
   
6.         r1 = .Cells(Rows.Count, 1).End(3).Row
   
7.         arr = .[a1].Resize(r1, 13)
   
8.         For i = 2 To UBound(arr)
   
9.             s = arr(i, 2)
   
10.             d(s) = i
    
11.         Next
    
12.         s = Sheets("修改录入").[c3].Value
    
13.         If d.exists(s) Then
    
14.             r = d(s)
    
15.         Else
    
16.             r = r1 + 1
    
17.             .Cells(r, 1) = r1
    
18.         End If
    
19.         For x = 1 To UBound(b)
    
20.             .Cells(r, x + 1) = Sheets("修改录入").Range(b(x)).Value
    
21.         Next
    
22.     End With
    
23.     Set d = Nothing
    
24.     Application.ScreenUpdating = True
    
25.     MsgBox "OK！"
    
26. End Sub
    

复制代码