透过按钮，执行资料复制

爱疯 · 发表于 2019-11-28 09:45

哪儿不清楚？
可以重新编辑下，将不清楚地方标下颜色。

lkk0063 · 发表于 2019-11-28 09:50

爱疯发表于 2019-11-28 09:45
哪儿不清楚？
可以重新编辑下，将不清楚地方标下颜色。

版主你好,

(1) 红字部分我不明白

Dim i, j, k
ThisWorkbook.Activate
A = Range("a1").CurrentRegion
B(1, 1) = [G1]
B(1, 2) = [C1]
B(1, 3) = [E1]
k = 3
For i = 3 To UBound(A)
For j = 1 To 5
k = k + 1
<font color="#ff0000"> B(1, k) = IIf(j > A(i, 11), "", A(i, j + 5))</font>
Next j
Next i
End Sub

复制代码

(2) 红字部分我不明白

'To Test-FQC
Sub step2()
Dim p, f
p = ThisWorkbook.Path & ""
f = "Test-FQC.xls"
Call step3(f)
With Workbooks.Open(p & f)
<font color="#ff0000"> Cells(6, 1).Resize(1, UBound(B, 2)) = B</font>
.Close True
End With
End Sub

复制代码

爱疯 · 发表于 2019-11-28 09:59

lkk0063 发表于 2019-11-28 09:50
版主你好,

(1) 红字部分我不明白

If x > 0 Then
y = 2
Else
y = 3
End If

如果情况简单，if语句可通过IIf 函数，达到简化书写的目的
y = IIf(x > 0, 2, 3)

～～～～～～～～～～～～～分割线～～～～～～～～～～～～～～～～～～
B(1, k) = IIf(j > A(i, 11), "", A(i, j + 5))
对于本题来说，上句等同于下面IF语句

If j > A(i, 11) Then
B(1, k) = ""
Else
B(1, k) = A(i, j + 5)
End If

爱疯 · 发表于 2019-11-28 10:05

lkk0063 发表于 2019-11-28 09:50
版主你好,

(1) 红字部分我不明白

Cells(6, 1).Resize(1, UBound(B, 2)) = B

意思是，从6行1列，即A6单元格开始，扩展到1行多列。
具体是多少列呢？就是数组B的第2维的上界，有58列，从A列到BF列。
这样，就可把数组B全部内容赋值到A6:BF6.

lkk0063 · 发表于 2019-11-28 11:31

本帖最后由 lkk0063 于 2019-11-28 11:33 编辑

谢谢版主注解，另外我想要在Test-FQC 有卡批号重覆无法复制资料功能 & 資料要累积下去，能新增吗?

爱疯 · 发表于 2019-11-28 11:56

19楼主要是把 Test-IPQC 的f3:j13, 输出到 Test-FQC 的第6行。

“在Test-FQC 有卡批号重覆无法复制资料功能”，看不懂这句想做什么？
如果用文字描述，手工做是怎样的？只需说明前3次，应该就行了。

lkk0063 · 发表于 2019-11-28 12:20

爱疯发表于 2019-11-28 11:56
19楼主要是把 Test-IPQC 的f3:j13, 输出到 Test-FQC 的第6行。

版主你好,
在Test-FQC 档案中，我的批号不能有重覆的(Lot ID)，有重覆资料就无法转档

爱疯 · 发表于 2019-11-28 15:04

lkk0063 发表于 2019-11-28 12:20
版主你好,
在Test-FQC 档案中，我的批号不能有重覆的(Lot ID)，有重覆资料就无法转档

每当Test-IPQC的数据全部录入完了后，点 add data，就把这些数据保存到 Test-FQC 中的最后一行。

题意是这样吗？
如果不是，那是怎样的
如果是，是不是 Lot ID 已存在，则不保存到 Test-FQC？

lkk0063 · 发表于 2019-11-28 15:16

爱疯发表于 2019-11-28 15:04
每当Test-IPQC的数据全部录入完了后，点 add data，就把这些数据保存到 Test-FQC 中的最后一行。

版主你好,
是不是 Lot ID 已存在，则不保存到 Test-FQC
對, 就是這樣

爱疯 · 发表于 2019-11-28 17:11

Sub cp()
Dim p, f, ID, wb, rng
Application.ScreenUpdating = False
p = ThisWorkbook.Path & "\"
f = "Test-FQC.xls"
ID = [G1]

Call CloseWorkbook(f)
Set wb = Workbooks.Open(p & f)
Set rng = Range("a:a").Find(ID)
If rng Is Nothing Then
      Call OneRow(wb)
Else
      MsgBox "Lot ID Already exist.", , ID
End If
wb.Close True
End Sub

Sub OneRow(wb)
Dim A
Dim B(1 To 1, 1 To 58) '58 = 1 + 1 + 1 + 5 * 11
Dim i, j, k
ThisWorkbook.Activate
A = Range("a1").CurrentRegion
B(1, 1) = [G1]
B(1, 2) = [C1]
B(1, 3) = [E1]

k = 3
For i = 3 To UBound(A)
      For j = 1 To 5
         k = k + 1
         B(1, k) = IIf(j > A(i, 11), "", A(i, j + 5))
      Next j
Next i

wb.Activate
i = Cells(Rows.Count, 2).End(xlUp).Row + 1
Cells(i, 1).Resize(1, UBound(B, 2)) = B
End Sub

Sub CloseWorkbook(f)
On Error Resume Next
Workbooks(f).Close 0
On Error GoTo 0
End Sub

f.rar (33.42 KB, 下载次数: 10)

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