itsource

셀 범위에 "F2"+"Enter" 강제 적용

mycopycode 2023. 6. 16. 21:44
반응형

셀 범위에 "F2"+"Enter" 강제 적용

다른 시트의 데이터를 다른 시트의 특정 형식으로 복사할 수 있는 매크로가 있는 Excel 2010 워크시트가 있습니다.

데이터가 복사되지만 날짜 또는 시간 값을 포함하는 셀 범위의 형식 지정에 문제가 있습니다.

데이터는 데이터베이스 추출에서 생성되며 모든 것은 텍스트 형식입니다.날짜를 복사할 때(VBA를 통해) 워크시트에서 형식을 적용합니다."yyyy-mm-dd"날짜 및 날짜에 대해"hh:mm.ss.ss"몇 번이고

행의 양이 고정되어 있지 않기 때문에 다음과 같이 셀 범위에 포맷을 적용하도록 VBA 코드를 설정했습니다.

AssDateLastRow = shAss.Range("C" & Rows.Count).End(xlUp).Row

shAss.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd"

범위의 모든 셀이 올바른 형식을 가지고 있는 것은 아닙니다. 셀은 다음과 같이 나타납니다.15/04/2014것은 아니다.2014-04-15수동으로 셀을 선택하고 키를 누르면 형식이 필요에 따라 나타납니다.이는 범위 내에서 무작위로 발생하며, 수천 개의 행이 있을 수 있으므로 워크시트에서 각 행에 대해 수동으로 +ENTER를 눌러 트롤링하는 것은 실용적이지 않습니다.

인터넷에서 VBA로 +를 ENTER자동으로 실행해야 하는 방법을 찾았습니다.

아래 코드는 더 큰 코드 라인 집합에서 추출되었습니다. 그래서,Dim진술 등은 실제 사본에 더 있지만, 이것은 제가 지금까지 이 문제를 해결한 방법을 보여줄 것입니다.

Dim shAss As Worksheet
Dim AssDateLastRow As Long
Dim c As Range

'enter method to format 'Date Craftperson Assigned' and 'Time Craftperson Assigned' in   Assignments sheet
'column "C" and "D", to formats required by Archibus: date "yyyy-mm-dd", time  "hh:mm.ss.ss"
AssDateLastRow = shAss.Range("C" & Rows.Count).End(xlUp).Row
shAss.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd"
'ensure format is applied by forcing F2 edit of cell
For Each c In shAss.Range("C4:C" & AssDateLastRow).Cells
    c.Select
    SendKeys "{F2}", True
    SendKeys "{ENTER}", True
'Selection.NumberFormat = "yyyy-mm-dd"
Next

코드를 실행하면 데이터가 워크시트에 복사되지만 날짜와 시간은 여전히 혼합 형식입니다.

VBA를 통해 ENTER+를 강제로 적용하려는 시도는 아무 것도 하지 않은 것 같습니다.수동으로 수행하면 정상적으로 작동합니다.

다음은 워크시트의 결과에서 복사한 데이터의 예입니다.

Work Request Code       Date Assigned       Time  Assigned
92926                   19/05/2014          14:30.00.00
92927                   19/05/2014          15:00.00.00
92928                   2014-05-19          15:15.00.00
92934                   2014-05-19          14:00.00.00
92527                   12/05/2014          07:30
92528                   12/05/2014          08:00
92804                   2014-05-12          16:15
92805                   2014-05-12          16:20.00.00

이 간단한 매크로를 사용하여 현재 선택한 범위에 +를 적용합니다.

Sub ApplyF2()
    Selection.Value = Selection.FormulaR1C1
End Sub

엑셀로 하여금 한 번에 셀에 포맷을 적용하게 하는 두 가지 방법을 생각해 볼 수 있습니다.

첫 번째 방법은 열에 분할할 내용이 없더라도 텍스트를 열로 기능을 사용하는 것입니다.두 번째 옵션은 1의 값을 복사한 후 특수 붙여넣기 - 곱하기 옵션을 사용하여 셀에 붙여넣는 것입니다.

어느 방법이든 셀 형성을 강제로 업데이트해야 하지만, 저는 첫 번째 옵션을 선택할 것입니다.이는 일부 날짜가 텍스트로 저장되는 경우입니다.

    Sub Format_Text_to_Columns()

    Dim AssDateLastRow As Long

    AssDateLastRow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
    ActiveSheet.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd;@"
    'Set the format

        Range("C4:C" & AssDateLastRow).Select
        Selection.TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, _
         Space:=True, FieldInfo:=Array(1, 5)
    'Use text to columns to force a format update

    End Sub



    Sub Format_Paste_Special_Multiply()

    Dim AssDateLastRow As Long

    AssDateLastRow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
    ActiveSheet.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd;@"
    'Set the format

        Range("C1").FormulaR1C1 = "1"
        Range("C1").Copy
        Range("C4:C" & AssDateLastRow).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply
        Application.CutCopyMode = False
        Range("C1").ClearContents
    'Multiply the dates by 1 to force a format update

    End Sub

저도 이걸 작동시키기 위해 애썼습니다.저의 문제는 단순히 날짜뿐만 아니라 앞에 인용문이 하나 있는 데이터였습니다.제가 함께 해킹한 것은 저에게 매우 유용합니다.그것은 70,000개 이상의 세포를 매우 빠르게 청소합니다.도움이 되길 바랍니다.

(필요에 따라 범위 등을 변경합니다.)

    Dim MyRange As Range

    Set MyRange = Range(Cells(2, 7), [G1].End(xlDown))

    For Each MyRange In MyRange.Cells
    'Mimic F2 without SendKeys
        MyRange.Value = MyRange.Value
    Next

이것은 저에게 효과가 있었습니다.

Dim r As Range
Dim n As Integer
Dim AssDateLastRow As Long

AssDateLastRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row

Set r = Range("E2:E" & AssDateLastRow)
r.Select
r.NumberFormat = "ddmmyyyy;@"
r.Select
For n = 1 To r.Rows.Count
    SendKeys "{F2}", True
    SendKeys "{ENTER}", True
Next n

텍스트를 열로 사용하여 이 문제를 해결할 수 있습니다.

데이터 열 강조 표시

데이터로 이동 -> 텍스트 열 -> 구분 -> (모두 선택 취소) -> 다음

마법사의 3페이지에서 열 데이터 형식 YMD를 설정합니다.

오케이

Sub RefreshCells()

Dim r As Range, rr As Range
Set rr = Selection
For Each r In rr
r.Select
Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Application.CutCopyMode = False

    Application.SendKeys "{F2}"
    Application.SendKeys "{ENTER}"
    Application.SendKeys "+{ENTER}"
    DoEvents
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Application.CutCopyMode = False

    Application.SendKeys "{ENTER}"

    DoEvents

Next



End Sub

키 F2 + Enter 키를 보내야 하는 것이 이상합니다.매크로를 실행하기 전의 형식은 무엇입니까?텍스트에 영향을 미치지 않는 방식으로 전체 열의 형식을 지정합니다.

Columns("C:C").NumberFormat = "yyyy-mm-dd"

나의 변주곡

n = Selection.Rows.count
Dim r1 As range, rv As range
Set r1 = Selection.Cells(1, 1)
For I = 1 To n
Set rv = r1.offset(I - 1, 0)
vali = rv.value
 IsNumeric(vali) Then
 vali = CDbl(vali)
 rv.value = 0
 rv.value = vali
 End If

F9 또는 File-Option-formula-Workbook calculation-automatic을 눌러 보십시오.

상단 항목의 오른쪽에 있는 셀을 문제의 셀을 1배로 곱한 공식과 동일하게 설정했습니다.그 새 셀은 적절한 숫자였기 때문에 핸들을 두 번 클릭하면 전체 열이 아래로 확장되어 모든 셀이 수정되었습니다!

전송 키가 안정적이지 않습니다.더 나은 방법은 텍스트를 클립보드에 저장하고 붙여넣는 것입니다.

클립보드에 값을 저장하는 방법은 여기를 참조하십시오.

Sub CopyText(Text As String)
Dim MSForms_DataObject As Object
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText Text
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub

Sub Test()
CopyText (ActiveCell.Value)
ActiveCell.PasteSpecial
End Sub
'In place of active cell, you may pass a range

이것은 나에게 효과가 있습니다.

Sub f2Cells(sel as Range)
    Dim rng as Range

    On Error GoTo exitHere

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    For Each rng In sel.Cells
        If Not Intersect(sel, Application.Range(rng.Address)) Is Nothing And _
            Application.Range(rng.Address).EntireColumn.Hidden = False And _
            Application.Range(rng.Address).EntireRow.Hidden = False Then
                Application.Range(rng.Address).Application.SendKeys "({F2}{ENTER})", True
        End If
    Next rng

exitHere:
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    Application.SendKeys "{NUMLOCK}", True
End Sub

그러면 당신의 기능으로 당신은 그냥 전화할 수 있습니다.

f2Cells shAss.Range("C4:C" & AssDateLastRow)

알았어요, 요, ㅠㅠ
F2를 누를 모든 셀을 선택하고 Enter를 눌러 이 짧은 매크로를 실행합니다.

하위 AutoF2Enter()
선택.=값 = 선택.가치
끝 하위 항목

날짜와 숫자에 따라 작동합니다!
의 셀!1초에 50,000개의 세포!

언급URL : https://stackoverflow.com/questions/24060831/force-f2enter-on-range-of-cells

반응형