填入中间空白的位置该采用那种方法

wuaijie · 发表于 2023-4-8 14:18

本帖最后由 wuaijie 于 2023-4-9 11:40 编辑

如案例所示，
在“”出库单“”中数据是不连续的，想把“采购单”中的内容写到“出库单”里，合成一个出入库的流水，该怎么写呢？
用usedrange不行，用currentregion也不行，该如何解决呢
要求：
1、将采购单中的餐点、米面油其他、调料副食等不易坏的月初采购，蔬菜水果和肉按周采购，共分为两类。也就是表格中“”出库“”部分是依据，要生成汇总表里的“”入库“”部分，参照要求是表格中绿色部分，一个是日期，一个是分类。
“预算出库数据”是原数据表，“出入库合并”是要实现的表。

2、将“蔬菜水果和肉”的内容写在每周的周一，其他部分写在月初第一天即可。

3、中间空白不够自动补足空行。这个太复杂的话可以不做，到时候表格多留一些空行，如果有好方法，请老师们展示

下边是我写的：
Sub hebing()

Range("B3:B18,D3:D18").Select
ActiveWindow.SmallScroll Down:=45
Range("B3:B18,D3:D18,B52:B91").Select
Range("B52").Activate
ActiveWindow.SmallScroll Down:=-33
Range("B3:B18,D3:D18,B52:B91,D52:D91").Select
Range("D52").Activate
Selection.Copy
Sheets("出库单").Select
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D181").Select
Sheets("采购单").Select
ActiveWindow.SmallScroll Down:=-33
Range("B19:B51,D19:D51").Select
Range("D51").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("出库单").Select
Range("D180").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=30
End Sub
只能固定内容复制，还不如直接复制粘贴快了
请各位你老是指导一下

wuaijie · 发表于 2023-4-8 14:44

大家都午休了么，都没人看

wuaijie · 发表于 2023-4-8 16:27

怎么解决呢？

wuaijie · 发表于 2023-4-8 16:57

大家全部休假中，

洋务德雷 · 发表于 2023-4-8 17:46

数据表设置有问题。需要重新调整。把你的主要想要达到的目的再说一下。

wuaijie · 发表于 2023-4-8 17:58

洋务德雷发表于 2023-4-8 17:46
数据表设置有问题。需要重新调整。把你的主要想要达到的目的再说一下。

就是把采购表中的内容，填写到出库单里面
要求：
1、把采购单的内容分开填写
2、出库单中的内容是分开的，每天中间有空行
3、要把采购单中的内容分别填写到不同日期当中
4、具体是蔬菜水果等易坏的分周采购，鉴于复杂，在我学习方法后可以再研究，如果老师能指导一下方法更是感激不尽
5、除了蔬菜水果和肉，其他的按月一次采购，直接填到月初。
6、具体难度在出库表中已经有了数据，不知道该怎么才能把这些按要求插进去
7、刚开始学，学过有usedrange判断最后一行，然后复制过去，但在这用不了，所以请老师给一下解决方案

盼哥 · 发表于 2023-4-8 18:11

本帖最后由盼哥于 2023-4-8 19:58 编辑

Option Explicit
Option Base 1 '设置数组索引从1开始
'专业VBA开发，生产优质代码！
Sub test()
Dim 规则1, 规则2, 位置1, 位置2
'规则
规则1 = Array("餐点", "米面油其他", "调料副食")
规则2 = Array("蔬菜水果")
位置1 = "2023-3-1"
位置2 = "2023-3-6"
Dim tmpWorkbook As Workbook
ThisWorkbook.Sheets("采购单").Copy
Set tmpWorkbook = ActiveWorkbook
With tmpWorkbook.Sheets("采购单")
Dim cell As Range
Dim mergedCellRange As Range
Dim i As Integer
For Each cell In ActiveSheet.UsedRange
If cell.MergeCells Then
Set mergedCellRange = cell.MergeArea
With mergedCellRange
'获取合并单元格的内容
Dim cellText As String
cellText = cell.Value
'取消合并单元格
mergedCellRange.UnMerge
cell.Value = cellText
'将单元格内容填充到所有拆分出的单元格中
For i = 1 To .Cells.Count
.Cells(i).Value = cellText
Next
End With
End If
Next
Dim arr
arr = .UsedRange
End With
tmpWorkbook.Close False
Dim s$
For i = 1 To UBound(arr)
s = arr(i, 1)
If 条件成立(s, 规则1) Then
Call 写入(i, arr, 位置1)
Else
If 条件成立(s, 规则2) Then
Call 写入(i, arr, 位置2)
End If
End If
Next
End Sub
Sub 写入(i, arr, 位置)
Dim tRange As Range, r&
On Error Resume Next
With ThisWorkbook.Sheets("出库单")
Set tRange = .UsedRange.Columns("C").Find(位置)
If tRange Is Nothing Then
Exit Sub
End If
r = tRange.Row
.Rows(r).Insert Shift:=xlShiftDown
.Cells(r, "D") = arr(i, 2)
.Cells(r, "E") = arr(i, 4)
.Cells(r, "F") = arr(i, 5)
.Cells(r, "G") = arr(i, 6)
.Cells(r, "H") = arr(i, 3)
.Cells(r, "I") = arr(i, 1)
.Cells(r, "K") = "入库"
End With
On Error GoTo 0
End Sub
Function 条件成立(s$, arr)
条件成立 = False
Dim i&
For i = 1 To UBound(arr)
If s = arr(i) Then
条件成立 = True
Exit For
End If
Next
End Function
Sub mkOBJ(book As Workbook, x$)
'根据字符串创建Book对象
'判断文件已经打开
Dim eachBook
For Each eachBook In Workbooks
If InStr(eachBook.Name, x) > 0 Then
Set book = eachBook
Exit Sub
End If
Next
Dim fName$
fName = Dir(ThisWorkbook.Path & "" & "*" & x & "*")
If fName = "" Then
MsgBox x & "不存在"
End
Else
fName = ThisWorkbook.Path & "" & Left(x, InStrRev(x, "")) & fName
Set book = Workbooks.Open(fName)
End If
End Sub

复制代码

洋务德雷 · 发表于 2023-4-8 18:22

wuaijie 发表于 2023-4-8 17:58
就是把采购表中的内容，填写到出库单里面
要求：
1、把采购单的内容分开填写

我是说，你的数据表设置有问题，是数据结构不对。学习vba要从最根本的问题学起。就是数据结构。你这个应该是出入库的一种管理。
我在这方面的观点是SQL+vba。基础数据要合理设置，才能使用简洁的代码完成汇总。

wuaijie · 发表于 2023-4-8 18:40

洋务德雷发表于 2023-4-8 18:22
我是说，你的数据表设置有问题，是数据结构不对。学习vba要从最根本的问题学起。就是数据结构。你这个应 ...

那请老师给优化一下，该怎么做，数据表怎么做，请重编一下

fanyoulin · 发表于 2023-4-8 19:47

wuaijie 发表于 2023-4-8 17:58
就是把采购表中的内容，填写到出库单里面
要求：
1、把采购单的内容分开填写

我只能给你提下建议，因为你这个表没有填充标识，我感觉写不了代码：
1、可以在采购单中添加一列“类型”，可以分为“耐用品”、“易耗品”，我只是举例，就是这个意思吧；
2、然后把耐用品插入到最前面，易耗品插入到你希望的地方；
3、你说把易耗品插入到3-6日之间，这个我感觉不象是固定的吧？如果是固定的，代码也简单。但如果是要求按照每周的采购周期来插入，你又没说明白每个月4周是如何分开排列的，所以总体上你这个要求是很含糊的，我是没看懂；

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

[求助] 填入中间空白的位置该采用那种方法