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

wuaijie

fanyoulin 发表于 2023-4-8 19:47
我只能给你提下建议，因为你这个表没有填充标识，我感觉写不了代码：
1、可以在采购单中添加一列“类型 ...

老师，填充标识能否按照我提到的蔬菜水果，肉类做为易耗品，其他做为耐用品分类了
第二，老师你分析的对，我计划就是把“易耗品”插入到每个星期一。
你看这样能不能写了

洋务德雷

wuaijie 发表于 2023-4-8 18:40
那请老师给优化一下，该怎么做，数据表怎么做，请重编一下

文件给你整理了，需要你填写入库的日期。然后再发过来。要不加我好友。

wuaijie

根据老师们建议，更改了初始数据工作表，请看是否合理了

wuaijie

洋务德雷 发表于 2023-4-9 09:42
文件给你整理了，需要你填写入库的日期。然后再发过来。要不加我好友。

老师，根据你的建议我重新制作了数据表，你看可以了么

wuaijie

fanyoulin 发表于 2023-4-8 19:47
我只能给你提下建议，因为你这个表没有填充标识，我感觉写不了代码：
1、可以在采购单中添加一列“类型 ...

我将数据表按月弄完整了，老师你看这样可以了没？

洋务德雷

wuaijie 发表于 2023-4-9 11:25
老师，根据你的建议我重新制作了数据表，你看可以了么

为什么还要留出空白的单元格？不是给你调整了数据结构了吗？
而且，题头没必要，起始点就从A1单元格开始，不要空出AB两列来。
先把数据调整好，再说后面你要的东西。

selen

Sub hebing()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim j As Integer
    Dim k As Integer
   
    ' 获取采购单工作表和出库单工作表
    Set sourceSheet = Sheets("采购单")
    Set targetSheet = Sheets("出库单")
   
    ' 清空出库单内容
    targetSheet.Range("B3:D180").ClearContents
   
    ' 将“不易坏的月初采购”数据添加到出库单中
    targetSheet.Range("B3").Value = "不易坏的月初采购"
    targetSheet.Range("C3").Value = "日期"
    targetSheet.Range("D3").Value = "数量"
    lastRow = sourceSheet.Cells(Rows.Count, "B").End(xlUp).Row
    j = 4
    For i = 19 To lastRow
        If sourceSheet.Cells(i, "B").Value = "不易坏的月初采购" Then
            targetSheet.Cells(j, "B").Value = sourceSheet.Cells(i, "B").Value
            targetSheet.Cells(j, "C").Value = DateSerial(Year(sourceSheet.Cells(i, "C").Value), Month(sourceSheet.Cells(i, "C").Value), 1)
            targetSheet.Cells(j, "D").Value = sourceSheet.Cells(i, "D").Value
            j = j + 1
        End If
    Next i
   
    ' 将“蔬菜水果和肉按周采购”数据添加到出库单中
    targetSheet.Range("B52").Value = "蔬菜水果和肉按周采购"
    targetSheet.Range("C52").Value = "日期"
    targetSheet.Range("D52").Value = "数量"
    j = 53
    k = 1
    For i = 19 To lastRow
        If sourceSheet.Cells(i, "B").Value = "蔬菜水果和肉按周采购" Then
            Dim weekStart As Date
            weekStart = DateSerial(Year(sourceSheet.Cells(i, "C").Value), Month(sourceSheet.Cells(i, "C").Value), Day(sourceSheet.Cells(i, "C").Value) - Weekday(sourceSheet.Cells(i, "C").Value, vbMonday) + 1)
            targetSheet.Cells(j, "B").Value = sourceSheet.Cells(i, "B").Value
            
            For k = 1 To 7
                targetSheet.Cells(j, "C").Value = weekStart + k - 1
                targetSheet.Cells(j, "D").Value = ""
                j = j + 1
            Next k
            
            ' 在当前行的前一列中填写数量
            targetSheet.Cells(j - 8, "D").Value = sourceSheet.Cells(i, "D").Value
        End If
    Next i
   
    ' 删除多余的空行
    lastRow = targetSheet.Cells(Rows.Count, "B").End(xlUp).Row
    targetSheet.Rows(lastRow + 1 & ":" & 180).Delete Shift:=xlUp
   
    ' 自动补足空行
    j = targetSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
    For i = j To 180
        targetSheet.Cells(i, "B").Value = ""
        targetSheet.Cells(i, "C").Value = ""
    targetSheet.Cells(i, "D").Value = ""
Next i

MsgBox "合并完成！"
End Sub

wuaijie

selen 发表于 2023-4-9 16:00
Sub hebing()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet

老师，我试了一下，好像不能实现，逐句看了，以为的水平找不问题出在哪，你到看一下。
我逐行看了下就是b3:d3和b52:d52填了六个 空。

wuaijie

等待完美方案

luohua@luowei

向大佬们学习