原来的宏

Sub 生成中山一院预约记录表()

 

If MsgBox(“1、最多只处理500条订单,如超出请联系技术部。2、订单数量大时请耐心等待。”, vbOKCancel) <> vbOK Then Exit Sub

 

ThisWorkbook.Worksheets(“sheet2″).Unprotect “85666190″

Sheet2.Select

Range(“a7:h10000″).Select ‘先清除历史数据

Selection.Delete

 

i = 3 ‘订单起始行数为3

j = 2 ‘打印页的 数据行 起始行数

a = i + 1 ‘订单第二行

b = i + 2 ‘订单第三行

c = i + 3 ‘第四行,如果没有流水号数据将停止复制

k = j + 1 ‘打印页的第二行数据

l = j + 2 ‘第三行

m = j + 3 ‘第四行

n = j + 4 ‘第五行

p = j + 6 ‘复制粘贴的起始行

x = p + 1 ‘粘贴的第二行

y = j – 1 ‘复制区域的起始行

e = i – 3 ‘确定处理的订单数量

f = i – 2

g = i – 1

h = j + 5 ‘需要调整行高的行

 

Do While i < 1000 ‘最大订单数为999

If Sheet1.Cells(i, 1) = “” Then GoTo end1 ‘没有数据则中止

‘If Sheet1.Cells(i, 1) > 0 Then Sheet2.Cells(j, 2) = Sheet1.Cells(i, 1)

If Sheet1.Cells(i, 11) > 0 Then Sheet2.Cells(k, 2) = Sheet1.Cells(i, 11)

If Sheet1.Cells(i, 6) > 0 Then Sheet2.Cells(l, 2) = Left(Sheet1.Cells(i, 6), 7)

If Sheet1.Cells(i, 5) > 0 Then Sheet2.Cells(m, 2) = Left(Sheet1.Cells(i, 5), 7)

If Sheet1.Cells(i, 7) > 0 Then Sheet2.Cells(n, 2) = Sheet1.Cells(i, 8   )

 

If Sheet1.Cells(a, 1) = “” Then GoTo end2

‘If Sheet1.Cells(a, 1) > 0 Then Sheet2.Cells(j, 5) = Sheet1.Cells(a, 1)

If Sheet1.Cells(a, 11) > 0 Then Sheet2.Cells(k, 5) = Sheet1.Cells(a, 11)

If Sheet1.Cells(a, 6) > 0 Then Sheet2.Cells(l, 5) = Left(Sheet1.Cells(a, 6), 7)

If Sheet1.Cells(a, 5) > 0 Then Sheet2.Cells(m, 5) = Left(Sheet1.Cells(a, 5), 7)

If Sheet1.Cells(a, 7) > 0 Then Sheet2.Cells(n, 5) = Sheet1.Cells(a, 8   )

 

If Sheet1.Cells(b, 1) = “” Then GoTo end3

‘If Sheet1.Cells(b, 1) > 0 Then Sheet2.Cells(j, 8  ) = Sheet1.Cells(b, 1)

If Sheet1.Cells(b, 11) > 0 Then Sheet2.Cells(k, 8  ) = Sheet1.Cells(b, 11)

If Sheet1.Cells(b, 6) > 0 Then Sheet2.Cells(l, 8  ) = Left(Sheet1.Cells(b, 6), 7)

If Sheet1.Cells(b, 5) > 0 Then Sheet2.Cells(m, 8  ) = Left(Sheet1.Cells(b, 5), 7)

If Sheet1.Cells(b, 7) > 0 Then Sheet2.Cells(n, 8  ) = Sheet1.Cells(b, 8   )

 

If i = 504 Then MsgBox “需要打印 28 张纸,纸张消耗过大,很不环保,请马上向公司汇报,点击确定继续”

 

Rows(h).Select

With ActiveWindow.RangeSelection

.RowHeight = 16

End With

If Sheet1.Cells(c, 1) = “” Then GoTo end4

‘Range(“a1:h6″).Select ‘选择最上面的6行进行复制

Cells(y, 1).Select ‘选择上面6行进行复制

Selection.Resize(Selection.Rows.Count + 5, Selection.Columns.Count + 7).Select

Selection.Copy

Sheet2.Cells(p, 1).Select

ActiveSheet.Paste

Sheet2.Cells(x, 2).Select ‘粘贴后先进行原有数据的清除

Selection.Resize(Selection.Rows.Count + 4, Selection.Columns.Count).Select

Selection.ClearContents

Sheet2.Cells(x, 5).Select

Selection.Resize(Selection.Rows.Count + 4, Selection.Columns.Count).Select

Selection.ClearContents

Sheet2.Cells(x, 8  ).Select

Selection.Resize(Selection.Rows.Count + 4, Selection.Columns.Count).Select

Selection.ClearContents

 

i = i + 3 ‘订单每隔三行循环

j = j + 7 ‘打印页每隔7行循环

a = i + 1

b = i + 2

c = i + 3

k = j + 1

l = j + 2

m = j + 3

n = j + 4

p = j + 6

x = p + 1

y = j – 1

e = i – 3

f = i – 2

g = i – 1

h = j + 5

 

Loop

 

end1:

MsgBox “已处理 ” & e & ” 条订单,请核对数据是否完整”

GoTo end5

 

end2:

MsgBox “已处理 ” & f & ” 条订单,请核对数据是否完整”

GoTo end5

 

end3:

MsgBox “已处理 ” & g & ” 条订单,请核对数据是否完整”

GoTo end5

 

end4:

MsgBox “已处理 ” & i & ” 条订单,请核对数据是否完整”

GoTo end5

 

end5:

 

ThisWorkbook.Worksheets(“sheet2″).Protect “85666190″

Range(“a2″).Select

End Sub

/———*****************——–/

要添加的一行数据索引 加多一行病人名称

 

Sub 生成中山一院预约记录表()

 

If MsgBox(“1、最多只处理500条订单,如超出请联系技术部。2、订单数量大时请耐心等待。”, vbOKCancel) <> vbOK Then Exit Sub

 

ThisWorkbook.Worksheets(“sheet2″).Unprotect “85666190″

Sheet2.Select

Range(“a8:h10000″).Select ‘先清除历史数据

Selection.Delete

 

i = 3 ‘订单起始行数为3

j = 2 ‘打印页的 数据行 起始行数

a = i + 1 ‘订单第二行

b = i + 2 ‘订单第三行

c = i + 3 ‘第四行,如果没有流水号数据将停止复制

k = j + 1 ‘打印页的第二行数据

l = j + 2 ‘第三行

m = j + 3 ‘第四行

n = j + 4 ‘第五行

v = j + 5

p = j + 7 ‘复制粘贴的起始行

x = p + 1 ‘粘贴的第二行

y = j – 1 ‘复制区域的起始行

e = i – 3 ‘确定处理的订单数量

f = i – 2

g = i – 1

h = j + 5 ‘需要调整行高的行

 

Do While i < 1000 ‘最大订单数为999

If Sheet1.Cells(i, 1) = “” Then GoTo end1 ‘没有数据则中止

‘If Sheet1.Cells(i, 1) > 0 Then Sheet2.Cells(j, 2) = Sheet1.Cells(i, 1)

If Sheet1.Cells(i, 11) > 0 Then Sheet2.Cells(l, 2) = Sheet1.Cells(i, 11)

If Sheet1.Cells(i, 2) > 0 Then Sheet2.Cells(k, 2) = Left(Sheet1.Cells(i, 2), 7)

If Sheet1.Cells(i, 6) > 0 Then Sheet2.Cells(m, 2) = Left(Sheet1.Cells(i, 6), 7)

If Sheet1.Cells(i, 5) > 0 Then Sheet2.Cells(n, 2) = Left(Sheet1.Cells(i, 5), 7)

If Sheet1.Cells(i, 7) > 0 Then Sheet2.Cells(v, 2) = Sheet1.Cells(i, 8   )

 

If Sheet1.Cells(a, 1) = “” Then GoTo end2

‘If Sheet1.Cells(a, 1) > 0 Then Sheet2.Cells(j, 5) = Sheet1.Cells(a, 1)

If Sheet1.Cells(a, 11) > 0 Then Sheet2.Cells(l, 5) = Sheet1.Cells(a, 11)

If Sheet1.Cells(a, 2) > 0 Then Sheet2.Cells(k, 5) = Left(Sheet1.Cells(a, 2), 7)

If Sheet1.Cells(a, 6) > 0 Then Sheet2.Cells(m, 5) = Left(Sheet1.Cells(a, 6), 7)

If Sheet1.Cells(a, 5) > 0 Then Sheet2.Cells(n, 5) = Left(Sheet1.Cells(a, 5), 7)

If Sheet1.Cells(a, 7) > 0 Then Sheet2.Cells(v, 5) = Sheet1.Cells(a, 8   )

 

If Sheet1.Cells(b, 1) = “” Then GoTo end3

‘If Sheet1.Cells(b, 1) > 0 Then Sheet2.Cells(j, 8  ) = Sheet1.Cells(b, 1)

If Sheet1.Cells(b, 11) > 0 Then Sheet2.Cells(l, 8  ) = Sheet1.Cells(b, 11)

If Sheet1.Cells(b, 2) > 0 Then Sheet2.Cells(k, 8  ) = Left(Sheet1.Cells(b, 2), 7)

If Sheet1.Cells(b, 6) > 0 Then Sheet2.Cells(m, 8  ) = Left(Sheet1.Cells(b, 6), 7)

If Sheet1.Cells(b, 5) > 0 Then Sheet2.Cells(n, 8  ) = Left(Sheet1.Cells(b, 5), 7)

If Sheet1.Cells(b, 7) > 0 Then Sheet2.Cells(v, 8  ) = Sheet1.Cells(b, 8  )

 

If i = 504 Then MsgBox “需要打印 28 张纸,纸张消耗过大,很不环保,请马上向公司汇报,点击确定继续”

 

Rows(h).Select

With ActiveWindow.RangeSelection

.RowHeight = 16

End With

If Sheet1.Cells(c, 1) = “” Then GoTo end4

‘Range(“a1:h6″).Select ‘选择最上面的6行进行复制

Cells(y, 1).Select ‘选择上面6行进行复制

Selection.Resize(Selection.Rows.Count + 6, Selection.Columns.Count + 8  ).Select

Selection.Copy

Sheet2.Cells(p, 1).Select

ActiveSheet.Paste

Sheet2.Cells(x, 2).Select ‘粘贴后先进行原有数据的清除

Selection.Resize(Selection.Rows.Count + 5, Selection.Columns.Count).Select

Selection.ClearContents

Sheet2.Cells(x, 5).Select

Selection.Resize(Selection.Rows.Count + 5, Selection.Columns.Count).Select

Selection.ClearContents

Sheet2.Cells(x, 8  ).Select

Selection.Resize(Selection.Rows.Count + 5, Selection.Columns.Count).Select

Selection.ClearContents

 

i = i + 3 ‘订单每隔三行循环

j = j + 8 ‘打印页每隔7行循环

a = i + 1

b = i + 2

c = i + 3

k = j + 1

l = j + 2

m = j + 3

n = j + 4

v = j + 5

p = j + 7

x = p + 1

y = j – 1

e = i – 3

f = i – 2

g = i – 1

h = j + 5

 

Loop

 

end1:

MsgBox “已处理 ” & e & ” 条订单,请核对数据是否完整”

GoTo end5

 

end2:

MsgBox “已处理 ” & f & ” 条订单,请核对数据是否完整”

GoTo end5

 

end3:

MsgBox “已处理 ” & g & ” 条订单,请核对数据是否完整”

GoTo end5

 

end4:

MsgBox “已处理 ” & i & ” 条订单,请核对数据是否完整”

GoTo end5

 

end5:

 

ThisWorkbook.Worksheets(“sheet2″).Protect “85666190″

Range(“a2″).Select

End Sub

 

 

复件 广州市番禺中心医院(模板)    (原件)

 

广州市番禺中心医院(模板)    (新件)

 

 

 

 

 
© 2012 Ai-WEB的博客 Suffusion theme by Sayontan Sinha