Board logo

標題: [發問] 將資料寫進固定format欄位中 [打印本頁]
作者: smartpearl    時間: 2013-7-2 22:11     標題: 將資料寫進固定format欄位中

各位大大,麻煩提供意見

要將原始的資料寫進固定format(如附件)
因為各家客戶,device對應到的Type有5種
若是沒有該種類的數據,則該種type則不會顯是在原始資料
但最後要寫盡的資料表中所呈現出來的format仍舊要有該欄位
如附件, 請問要從何寫起????麻煩提供意見給新手,謝謝謝謝

說明如附件或下面連結
https://www.dropbox.com/s/0ciopmd8k8pg9tn/Book9.xls
作者: GBKEE    時間: 2013-7-3 14:54

回復 1# smartpearl
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim 原始的資料 As Range, xType(), AR(1 To 2)
  4.     Dim 資料表 As Worksheet, I As Integer, ii As Integer, R As Integer
  5.     xType = Array("Actual", "A_REAL", "Plan", "ALLOCATE", "Non_Plan")  '5種 Type
  6.     Set 原始的資料 = Sheets("SHEET1").Range("a1").CurrentRegion
  7.     Set 資料表 = Sheets("SHEET2")
  8.     資料表.Cells.Clear
  9.     '*********************************************************************
  10.     '原始的資料於工作表, A1開始放置
  11.     '注意 :  原始的資料,CRP(F欗)的第1個有值: 補上其他位置的值,使用這行程式碼
  12.     原始的資料.Columns(6).SpecialCells(xlCellTypeBlanks).Value = "=R[-1]C"
  13.     '*********************************************************************
  14.     I = 1
  15.     Do
  16.         With 原始的資料
  17.             R = 資料表.Cells(資料表.Rows.Count, 1).End(xlUp).Row
  18.             If I >= 2 Then
  19.                 For ii = 0 To UBound(xType)
  20.                     R = R + 1
  21.                     With .Rows(I)
  22.                         AR(1) = Array(.Cells(2), .Cells(7), .Cells(4), .Cells(5), .Cells(6), .Cells(8))
  23.                                       'CUSTOMER    TESTER     DEVICE    DEVICE_GRP   CRP         TIME
  24.                         資料表.Cells(R, 1).Resize(1, 6) = AR(1)
  25.                     If .Cells(9) = xType(ii) Then
  26.                         AR(2) = Application.Transpose(Application.Transpose(.Cells(9).Resize(, .Columns.Count - 8)))
  27.                         資料表.Cells(R, 7).Resize(1, UBound(AR(2))) = AR(2)
  28.                         With 原始的資料.Rows(I + 1)
  29.                             '比對上下欄的資料
  30.                             If Join(Array(.Cells(0, 2), .Cells(0, 7), .Cells(0, 4), .Cells(0, 5), .Cells(0, 6)), ",") = Join(Array(.Cells(2), .Cells(7), .Cells(4), .Cells(5), .Cells(6)), ",") Then
  31.                                I = I + 1   '比對上下欄的資料相同
  32.                             End If
  33.                         End With
  34.                     Else
  35.                          資料表.Cells(R, 7) = xType(ii)
  36.                     End If
  37.                     End With
  38.                 Next
  39.             Else
  40.                 With .Rows(1)
  41.                     ' Array(.Cells(2), .Cells(7), .Cells(4), .Cells(5), .Cells(6), .Cells(8), .Cells(9))
  42.                             'CUSTOMER   TESTER      DEVICE   DEVICE_GRP    CRP        TIME       TYPE
  43.                     資料表.Cells(R, 1).Resize(1, 7) = Array(.Cells(2), .Cells(7), .Cells(4), .Cells(5), .Cells(6), .Cells(8), .Cells(9))
  44.                     AR(1) = .Range(.Cells(10), .Cells(.Columns.Count))
  45.                      With 資料表.[a1].End(xlToRight).Offset(, 1).Resize(1, UBound(AR(1), 2))
  46.                         .Value = AR(1)
  47.                         .NumberFormatLocal = "m/d;@"
  48.                        
  49.                       End With
  50.                     
  51.                 End With
  52.             End If
  53.             I = I + 1
  54.         End With
  55.     Loop Until I > 原始的資料.Rows.Count
  56.     With 資料表.Range("A1").CurrentRegion
  57.         .HorizontalAlignment = xlCenter
  58.         .VerticalAlignment = xlCenter
  59.         .WrapText = False
  60.         For I = 2 To .Rows.Count Step 5
  61.             .Rows(I & ":" & I + 4).BorderAround 1
  62.             Application.DisplayAlerts = False
  63.             For ii = 1 To 5
  64.                 .Columns(ii).Range("A" & I & ":A" & I + 4).MergeCells = True
  65.             Next
  66.             Application.DisplayAlerts = True
  67.         Next
  68.     End With
  69. End Sub
複製代碼




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