Board logo

標題: 程式碼修改 [打印本頁]
作者: y663258    時間: 2011-1-19 12:02     標題: 程式碼修改

  1.     Dim i&, R As Range, Y%

  3.     i = 2: Y = 1

  5.     With Sheet2

  7.         Do While .Cells(i, "b") <> ""

  9.            Set R = .Cells(i, "b")

  11.             With Sheet1.Cells(i - 1, Y)

  13.                 .Value = R & Chr(10) & R(1, 2) & R(1, 3) & R(1, 4) & Chr(10) & Chr(10) & R(1, 5) & Space(20) & R(1, 6) & "收" & Chr(10)

  15.                 .ColumnWidth = 33

  17.                 .Borders.LineStyle = xlContinuous

  19.                 .HorizontalAlignment = xlLeft

  21.                 .VerticalAlignment = xlCenter

  23.                 .IndentLevel = 1

  25.              End With

  27.             If Y = 1 Then

  29.              Y = 1: i = i + 1

  31.             Else

  33.                 Y = Y + 1

  35.             End If

  37.         Loop

  39.     End With

  41.   '  Sheet1.PrintOut

  43. End Sub
複製代碼
這程式碼是抄用其他大大所寫，我想改變資料寫入方式，1.原始方式是a1'b1'c1'''''向下寫入，可否改成a1,b1,c1,d1,e1,f1，再跳a2,b2,c2,d2,e2,f2。
2. R(1, 2)字大小10，R(1, 6)字大小14。自己想了許久就是無法達成，請先進幫忙。
作者: hugh0620    時間: 2011-1-19 12:12

回復 1# y663258


    建議是否貼個範例~ 會使大大們比較清楚你真正的需求是什麼~
    這樣會比較快幫你解決你的問題唷~~^^
作者: y663258    時間: 2011-1-19 16:02

附上檔案請大家幫忙囉![attach]4454[/attach]
作者: hugh0620    時間: 2011-1-20 15:46

回復 3# y663258

    新手~ 只有笨方法~ 不過測試是OK的~ 你可以試一下

  N = 0
For I = 1 To 2000
    For J = 1 To 6
            Sheet1.Cells(I, J) = Sheet2.Range("B" & N + 2) & Chr(10) & Sheet2.Range("C" & N + 2)
             W1 = Len(Sheet2.Range("B" & N + 1))
             W2 = Len(Sheet2.Range("C" & N + 1))
        With Sheet1.Cells(I, J).Characters(Start:=1, Length:=W1).Font
            .Name = "新細明體"
            .FontStyle = "標準"
            .Size = 12
        End With
        With Sheet1.Cells(I, J).Characters(Start:=W1 + 1, Length:=W1 + 1 + W2).Font
            .Name = "新細明體"
            .FontStyle = "標準"
            .Size = 10
        End With
        N = N + 1
        If Sheet2.Range("B" & N + 2) = "" Then Exit Sub
    Next
Next
作者: Hsieh    時間: 2011-1-20 16:15

回復 3# y663258
  1. Sub nn()
  2. Dim a(6), Ar()
  3. r = 2
  4. With Sheet2
  5. Do Until .Cells(r, 2) = ""
  6.    For i = 0 To 5
  7.       a(i) = .Cells(r + i, 2) & Chr(10) & .Cells(r + i, 3)
  8.    Next
  9.    ReDim Preserve Ar(s)
  10.    Ar(s) = a
  11.    s = s + 1
  12.    r = r + 6
  13. Loop
  14. End With
  15. Sheet1.[A1].Resize(s, 6) = Application.Transpose(Application.Transpose(Ar))
  16. End Sub
複製代碼
作者: hugh0620    時間: 2011-1-20 16:35

回復 5# Hsieh


    大大~ 你少漏了一個沒有寫到~
   R(1, 2)字大小10，R(1, 6)字大小14 文字"李一"大小12"，"1111"大小10"
   同一個儲存格 上面的字要size=12  , 下面的字要size=10
作者: y663258    時間: 2011-1-20 16:44

感謝hugh0620  Hsieh 二位大大幫助，祝福新年快樂。
作者: y663258    時間: 2011-1-20 16:54

再請教Hsieh大大 程式中如何去設定Cells(r + i, 2)文字大小12"及Cells(r + i, 3)二個文字大小文字大小12"
謝謝
作者: Hsieh    時間: 2011-1-20 19:29

回復 8# y663258
  1. Sub nn()
  2. Dim a(6), Ar(), C As Range
  3. r = 2
  4. With Sheet2
  5. Do Until .Cells(r, 2) = ""
  6.    For i = 0 To 5
  7.       a(i) = .Cells(r + i, 2) & Chr(10) & .Cells(r + i, 3)
  8.    Next
  9.    ReDim Preserve Ar(s)
  10.    Ar(s) = a
  11.    s = s + 1
  12.    r = r + 6
  13. Loop
  14. End With
  15. With Sheet1.[A1].Resize(s, 6)
  16. .Value = Application.Transpose(Application.Transpose(Ar))
  17. For Each C In .Cells
  18.    C.Characters(1, InStr(C, Chr(10))).Font.Size = 12
  19.    C.Characters(InStr(C, Chr(10)), 256).Font.Size = 10
  20. Next
  21. End With
  22. End Sub
複製代碼
作者: y663258    時間: 2011-1-21 08:55

謝謝Hsieh 版主，真是讓人讚佩，這樣就不受字數限制，跳行後該行字大小一致。



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)