Sub 查询系统()
Dim Crow, m, k As Integer
Dim rng As Range
ends = Sheet2.Columns(1).Find("*", , , , , xlPrevious).Row ''对第一列 从下往上查找 找到A列的最后一个单元格所在行
Crow = Application.CountA(Sheet2.Range("e:e")) ''''E列非空单元格的行数
Sheet2.Range("E3:G" & Crow + 2).Delete ''清除之前的结果
For Each rng In Sheet2.Range("a2:a" & ends)
m = m + 1
If rng Like Sheet2.Range("f1") Then '比较
k = k + 1
Sheet2.Range("a" & m + 1 & ":c" & m + 1).Copy Sheet2.Range("e" & k + 2 & ":g" & k + 2)
''把所在记录的行复制到
End If
Next
End Sub
'''入库单保存
Sub 入库单计算()
Dim es, rng As Range
Dim Saddress As String
Set es = Sheet1.Columns(3).Find("*", , xlFormulas, , , xlPrevious) '''查找最后个单元格
Saddress = es.address
ends = Sheet1.Range("c:c").Find("*", , , , , xlPrevious).Row '''最后单元的所在的行
Range([c5], Saddress).Select
If ends = 4 Then ''如果记录是从第4行是表列名 ,,就没有数据
MsgBox "请您先添加记录!", vbCritical, "错误提示"
Exit Sub
End If
For Each rng In Range([c5], es)
rng.Offset(0, 2) = rng * rng.Offset(0, 1) ''用offset(偏移行,偏移列)计算
Next
End Sub
Sub 入库单开单()
Dim Stime As String
Dim Scolumn As Range
Dim Aint, Bint As Integer
Set Scolumn = Cells.Find("*", , xlFormulas, , , xlPrevious) '''查找最后个单元格
Xcolumn = Cells.Find("*", , xlFormulas, , , xlPrevious).Row '''查找最后个单元格所在的行
''Set Scolumn = Range("e:e").Find("*", , xlFormulas, , , xlPrevious) '''查找该列的最后个单元格 xlFormulas单元格的公式 xlPrevious向上查找 ''查到的是个range对象
''s = Scolumn.address ''最后个单元格
''Range("a5", Scolumn.Offset(5)) = "" ''当最后个单元格没有数据的时候会少清空行
If Xcolumn > 4 Then ''防止把列名清空
Range("a5", Cells(Xcolumn, 5)) = ""
End If
Stime = Format(Now, "YYMMDDHHss")
Range("b2") = "SM" + Stime ''单号
Range("e2") = ""
End Sub
Sub 入库保存()
Dim rng As Range
Dim str As String
Dim Sint, Bint As Integer
Dim c, Csheet3 As String
Dim rngs As Range
Set rngs = Sheet3.Range("a:a").Find(Sheet1.Range("b2")) ';对A列单号进行搜索
If Not rngs Is Nothing Then '''判断是否存在记录
MsgBox "已存在记录!!"
Exit Sub
End If
'If Range("b2").Find(Sheet1.Range("b2")) = Sheet1.Range("b2") Then ''在工作表sheet2中 F列查找 b2单元格内容
'MsgBox "你已经保存过了,请查询", vbCritical, "重复保存提示"
'Exit Sub ''如果相等退出
'End If
Set rng = Cells.Find("*", , xlFormulas, , , xlPrevious) ''查找最后个单元格
str = rng.address
Sint = rng.Row ''最后单元格所在的行数
If Sint = 4 Then
MsgBox "没有记录需要保存!", vbInformation, "提示"
Exit Sub
End If
Bint = Cells.Find("*", , xlFormulas, , , xlPrevious).Row '''sheet1的记录行数
Csheet3 = Application.CountA(Sheet3.Range("a:a")) '''sheet3工作表已使用的行数
Range("a5:e" & Sint).Select
Range("a5:e" & Sint).Copy Sheet3.Range("c" & Csheet3 + 1 & ":g" & Csheet3 + Sint - 4) ''记录复制过去
Sheet3.Range("a" & Csheet3 + 1).Resize(Bint - 4).Value = [b2] ''保存单号 A列单元格向下偏移
Sheet3.Range("b" & Csheet3 + 1).Resize(Bint - 4) = [e2] ''保存厂商 A列单元格向下偏移
Sheet3.Range("h" & Csheet3 + 1).Resize(Bint - 4) = Now() ''保存日期 A列单元格向下偏移
End Sub
