§ì¨ú¨Ó·½¸ê®Æ¥t¦s¦b¥Øªº¤£¦Psheet¤¤
- ©«¤l
- 8
- ¥DÃD
- 4
- ºëµØ
- 0
- ¿n¤À
- 55
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 10
- ³nÅ骩¥»
- Office 2013
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-11-29
- ³Ì«áµn¿ý
- 2021-11-17
|
§ì¨ú¨Ó·½¸ê®Æ¥t¦s¦b¥Øªº¤£¦Psheet¤¤
¦U¦ì¥ý¶i̦n
¤p§Ì¦³´XÓ¨Ó·½¤å¥ó(ÀɦW¬Û¦Psheet¤º®e¤£¦P)¡AÁÙ¦³¤@ӥتº¤å¥ó¤À¦¨¦n´XÓsheet(¦Usheet¤¤¦U¦³¹ïÀ³¨Ó·½ÀÉ)¡A¨Ã«ü©w¿é¤Jnªº®É¶¡¶×¤J
¦³Ó¤p°ÝÃD
1.Ū¨ú¨Ó·½ÀÉ¥H°}¦CŪ¨ú§¹«á©¹¤U¤@¦CÄ~Äò¤£¬O©¹¤U¤@ÄæÄ~Äò¡A¦pªG§Úªº°}¦CÃþ«¬¬OÄæ¦C³£¦³ªº¸Ü¡C
2.Ū¨ú§¹n¼g¤J¥ØªºÀɮɷ|¼g¤J¥þ³¡sheet(·|¦bA1¼g¤J¤é´ÁB2¼g¤J®É¶¡¨ä¾lªÅ¥Õ) ¦Ó¤£¬O¥u¼g¤J¨ä¤¤¤@Ósheet¤º
½Ð°Ý¦U¦ì¥ý¶i¸Ó¦p¦ó§ó§ï- '¨C¤é³øªí¶×¤JÁ`¤é³øªí'
- Sub Test()
- Dim sFile, wbThis As Workbook, wbSrc As Workbook
- Dim lRowIndex As Long, lColIndex As Long, oDic As Object, aTime, sDate
- Dim sType As String, lShIndex As Long, lTimeIndex As Long
- Const lBlkWidth As Long = 13
- Const lBlkHeight As Long = 40
- sFile = Application.GetOpenFilename(fileFilter:="Excel Files (*.xls),*.xls", Title:="¿ï¾Ü¤é³øªí")
- If StrComp(TypeName(sFile), "Boolean", vbTextCompare) = 0 Then Exit Sub
- aTime = InputBox("¿é¤Jn°O¿ýªº®É¶¡" & "¥H³r¸¹¤À¶}¡A¤£nªÅ®æ)", , "00:00,08:00,16:00")
- If aTime = "" Then Exit Sub
- aTime = Split(aTime, ",")
- Application.ScreenUpdating = False
- Set wbThis = ThisWorkbook
- Set wbSrc = Workbooks.Open(Filename:=sFile, ReadOnly:=True)
- Set oDic = CreateObject("Scripting.Dictionary")
- With wbSrc.Sheets(1)
- sDate = .Range("TitleDate").Value
- For lRowIndex = .[A8].Row To .UsedRange.Rows.Count Step lBlkHeight
- For lColIndex = 2 To lBlkWidth
- sType = .Cells(lRowIndex, lColIndex).Value
- If sType <> "" And Left(sType, 1) <> "@" Then
- If Not oDic.exists(sType) Then
- Set oDic(sType) = CreateObject("scripting.dictionary")
- For Each x In .Cells(lRowIndex, 1).Offset(4).Resize(24)
- If x.Value <> "" Then oDic(sType)(x.Text) = x.Offset(, lColIndex - 1).Value
- Next
- End If
- End If
- Next
- Next
- End With
- wbSrc.Close
- Application.ScreenUpdating = True
- With wbThis
- For lShIndex = 1 To .Sheets.Count
- With .Sheets(lShIndex)
- lRowIndex = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
- .Cells(lRowIndex, "A").Value = sDate
- .Cells(lRowIndex, "B").Resize(UBound(aTime) + 1) = Application.Transpose(aTime)
- For lColIndex = 3 To .[C4].End(xlToRight).Column
- If oDic.exists(.Cells(4, lColIndex).Value) Then
- For lTimeIndex = 0 To UBound(aTime)
- .Cells(lRowIndex, lColIndex).Offset(lTimeIndex).Value = oDic(.Cells(4, lColIndex).Value)(aTime(lTimeIndex))
- Next
- oDic(.Cells(4, lColIndex).Value).RemoveAll
- oDic.Remove .Cells(4, lColIndex).Value
- End If
- Next
- End With
- Next
- End With
- MsgBox "¥Ø¼ÐÀɧ䤣¨ìÄæ¦ì¸ê®Æ: " & vbCrLf & Join(oDic.keys, ", ")
- 'cleanup
- For Each x In oDic
- oDic(x).RemoveAll
- oDic.RemoveAll
- Next
- End Sub
½Æ»s¥N½X |
-
-
Test.rar
(482.61 KB)
|
|
|
|
|
|