返回列表 上一主題 發帖

如何設定複製迴圈sheet1複製儲存格至sheet2固定位置????

lpk187

帖子
552 
主題
6 
精華
0 
積分
576 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2026-9-10 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
1# 跳轉到 »
發表於 2015-9-13 22:36 | 顯示全部帖子
回復 1# poke0817


  是這樣嗎？
我把標籤樣式改到Sheet3以應第2個問題
  1. Public Sub ex()
  2. Dim rng As Range, r%, c%
  3. Sheet3.Range("a1:h" & Sheet3.Cells(Rows.Count, 1).End(xlUp).Row).Delete
  4. r = 1
  5. c = 1
  6. For i = 1 To 8 Step 2
  7.     Sheet3.Columns(i).ColumnWidth = 9.65
  8.     Sheet3.Columns(i + 1).ColumnWidth = 18.13
  9. Next
  10. For Each rng In Sheet1.Range("a2:a" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
  11.     With Sheet3
  12.         If c < 8 Then
  13.             With .Range(.Cells(r, c), .Cells(r + 2, c + 1))
  14.                 .HorizontalAlignment = xlCenter
  15.                 .VerticalAlignment = xlCenter
  16.                 .WrapText = False
  17.                 .Orientation = 0
  18.                 .AddIndent = False
  19.                 .IndentLevel = 0
  20.                 .ShrinkToFit = True
  21.                 .ReadingOrder = xlContext
  22.                 .Borders(xlDiagonalDown).LineStyle = xlNone
  23.                 .Borders(xlDiagonalUp).LineStyle = xlNone
  24.                 With .Borders(xlEdgeLeft)
  25.                     .LineStyle = xlContinuous
  26.                     .ColorIndex = xlAutomatic
  27.                     .TintAndShade = 0
  28.                     .Weight = xlMedium
  29.                 End With
  30.                 With .Borders(xlEdgeTop)
  31.                     .LineStyle = xlContinuous
  32.                     .ColorIndex = xlAutomatic
  33.                     .TintAndShade = 0
  34.                     .Weight = xlMedium
  35.                 End With
  36.                 With .Borders(xlEdgeBottom)
  37.                     .LineStyle = xlContinuous
  38.                     .ColorIndex = xlAutomatic
  39.                     .TintAndShade = 0
  40.                     .Weight = xlMedium
  41.                 End With
  42.                 With .Borders(xlEdgeRight)
  43.                     .LineStyle = xlContinuous
  44.                     .ColorIndex = xlAutomatic
  45.                     .TintAndShade = 0
  46.                     .Weight = xlMedium
  47.                 End With
  48.                 With .Borders(xlInsideVertical)
  49.                     .LineStyle = xlContinuous
  50.                     .ColorIndex = xlAutomatic
  51.                     .TintAndShade = 0
  52.                     .Weight = xlThin
  53.                 End With
  54.                 With .Borders(xlInsideHorizontal)
  55.                     .LineStyle = xlContinuous
  56.                     .ColorIndex = xlAutomatic
  57.                     .TintAndShade = 0
  58.                     .Weight = xlThin
  59.                 End With
  60.                 With .Font
  61.                     .Name = "標楷體"
  62.                 End With
  63.             End With
  64.             With .Range(.Cells(r, c), .Cells(r, c + 1))
  65.                 .MergeCells = True
  66.                 .Value = "XX企業股份有限公司"
  67.                 With .Font
  68.                     .Size = 14
  69.                 End With
  70.             End With
  71.             .Cells(r + 1, c) = "財產編碼"
  72.             .Cells(r + 1, c + 1) = rng
  73.             .Cells(r + 2, c) = "品名"
  74.             .Cells(r + 2, c + 1) = rng.Offset(, 1)
  75.             c = c + 2
  76.         End If
  77.         If c > 8 Then
  78.             c = 1
  79.             r = r + 3
  80.         End If
  81.     End With
  82. Next
  83. End Sub
複製代碼

TOP

lpk187

帖子
552 
主題
6 
精華
0 
積分
576 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2026-9-10 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 2015-9-15 09:59 | 顯示全部帖子
回復 4# poke0817


    製作儲存格格式，和版本有關係！2003不相容！

TOP

        靜思自在 : 小事不做、大事難成。
返回列表 上一主題