'SI개발'에 해당되는 글 18건

  1. 2023.02.03 [VBA] Format Yahoo Fantasy Players List
  2. 2023.01.07 갤럭시 노트2 커스텀 롬
  3. 2023.01.07 커스텀롬 설치를 위한 사전 준비: ADB 설치
  4. 2022.12.11 [VBA]디렉토리 안의 파일 목록 구하기2
  5. 2021.12.21 SI개발을 생각하고 있는 비전공 신입분들에게
  6. 2021.03.27 [VBA] 차트 범례 추가, 삭제
  7. 2017.10.28 [VBA]디렉토리 안의 파일 목록 구하기
  8. 2017.06.18 [Xplatform][Miplatform] 그리드 체크박스 1개만 선택
  9. 2016.03.27 [VBA] 엑셀 디아블로2 my log(엑셀), jimmy's log(본문)
  10. 2016.03.26 [VBA]Excel. DB칼럼명을 Camel, pascal로 변환

Since Yahoo doesn't provide the data in Excel or Txt format, I need to strip tags and remove blanks.

PlayerList(MLB)_v0.1_2023.xls
0.15MB
PlayerList(MLB)_v0.2_2023.xls
0.17MB

 

This is only the draft version and the VBA code will be updated.

 

Option Explicit

' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 0.1       2023-Feb-03             delRow(), findValue()
' 0.2       2023-Feb-03             getTeamName()
' **************************************************************************************

Sub delRow()
    'MsgBox ActiveCell.Range
    Dim lRowCnt, lCntAA, lCntAB As Long
    Dim rngAll As Range

    Application.ScreenUpdating = False
    Call stripTag 'remove tags
    
    lCntAA = Application.CountA(Range("A:A")) 'count of non blank cells under A
    lCntAB = Application.CountA(Range("B:B")) 'count of non blank cells under B
    
    If (lCntAA < lCntAB) Then '14 < 31
        'MsgBox "lCntAA < lCntAB"
        MsgBox "Columns are not destroyed."
        Columns("A").Delete
    Else '145 > 0
        'MsgBox "lCntAA >= lCntAB"
        MsgBox "Columns are split into rows."
    End If
    
    Cells(1, "A").Select
    Set rngAll = Range([A1], Cells(Rows.Count, "A").End(xlUp))
    lRowCnt = rngAll.Rows.Count
    Call findValue(lRowCnt) 'Delete the rows if the values are not needed
 
    'Cells(1, "B").Select
    'Set rngAll = Range([B1], Cells(Rows.Count, "B").End(xlUp))
    'lRowCnt = rngAll.Rows.Count
    'Call findValue(lRowCnt) 'Delete the rows if the values are not needed
    
    'Columns("A").SpecialCells(4).EntireRow.Delete 'delete empty cell rows
    'MsgBox Application.CountA(Range("A:A"))
    Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes 'delete ""
 
    Range("A1").Select
    ActiveWindow.ScrollRow = 1
    Application.ScreenUpdating = True
End Sub

Sub stripTag()
    'Cells.Select
    'Dim rngSelected As Range
    'Set rngSelected = New Cells.Select
    'Call stripHtml(rngSelected) 'remove html
    Cells.Hyperlinks.Delete     'remove hyperlink
    ActiveSheet.Pictures.Delete 'remove pictures
    
    'MsgBox Application.CountA(Range("A:A")) & ", " & Application.CountA(Range("B:B"))
    'MsgBox Len(Range("A9:A9"))
End Sub

Private Sub findValue(ByVal lRowCnt As Long)
    Dim i, r As Integer
    Dim sSheetName As String
    Dim sActiveCellValue As String
    
    sSheetName = getTeamName
    
    For i = 1 To lRowCnt
        sActiveCellValue = ActiveCell.Value
        If IsNumeric(sActiveCellValue) Then
            Selection.EntireRow.Delete
            lRowCnt = lRowCnt - 1
            r = r + 1
        ElseIf sActiveCellValue Like "*player Notes" Or sActiveCellValue Like "Player Note" Or sActiveCellValue = "DTD" Or sActiveCellValue = sSheetName Then
            Selection.EntireRow.Delete
            lRowCnt = lRowCnt - 1
            r = r + 1
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Next i
    MsgBox r & " rows deleted"

End Sub

Private Function getTeamName() As String
    On Error GoTo ec1
    Dim sSheetName As String
    Dim vSheetName As Variant
    
    sSheetName = ActiveSheet.Name
    vSheetName = Split(sSheetName, "(")
    'MsgBox vSheetName(0)
    
    getTeamName = vSheetName(0)
ec1:

End Function

* 제품 Code: SHV-E250S (SKT, 한국)

* 갤럭시 노트2 출시일: 2012-09-26

 

1. 리니지 19.1: 안드로이드 12.1 -- 정상, GApps가 아직 11까지만 지원(오로라 스토어 내장)

[ROM][UNOFFICIAL][12L][N7100][Samsung Galaxy Note 2][LineageOS 19.1][BETA] | XDA Forums (xda-developers.com)

 

[ROM][UNOFFICIAL][12L][N7100][Samsung Galaxy Note 2][LineageOS 19.1][BETA]

/* * Your warranty is now void. * * I am not responsible for bricked devices, dead SD cards, * thermonuclear war, or you getting fired because the alarm app failed. Please * do some research if you have any concerns about features included in...

forum.xda-developers.com

 

2. 리니지 18.1: 안드로이드 11 -- 정상, GApps 설치가능

[ROM][UNOFFICIAL][11.0][N7100][Samsung Galaxy Note 2][LineageOS 18.1][BETA][TREBLELIZED] | XDA Forums (xda-developers.com)

 

[ROM][UNOFFICIAL][11.0][N7100][Samsung Galaxy Note 2][LineageOS 18.1][BETA][TREBLELIZED]

/* * Your warranty is now void. * * I am not responsible for bricked devices, dead SD cards, * thermonuclear war, or you getting fired because the alarm app failed. Please * do some research if you have any concerns about features included in...

forum.xda-developers.com

 

3. 리니지 20: 안드로이드 13 -- 댓글에 보니 너무 무겁다고 해서 pass

[ROM][UNOFFICIAL][13][ I9300 ][ LineageOS 20.0 ][ALPHA] | XDA Forums (xda-developers.com)

 

[ROM][UNOFFICIAL][13][ I9300 ][ LineageOS 20.0 ][ALPHA]

/* * Your warranty is now void. * * I am not responsible for bricked devices, dead SD cards, * thermonuclear war, or you getting fired because the alarm app failed. Please * do some research if you have any concerns about features included in...

forum.xda-developers.com

 

4. 설치방법(일반론)

https://youtu.be/EG19K_pedLk

 

5. 결과

https://youtu.be/whpnOUBpD_c

 

※ 관련링크

LineageOS - 나무위키 (namu.wiki)

 

LineageOS - 나무위키

이 저작물은 CC BY-NC-SA 2.0 KR에 따라 이용할 수 있습니다. (단, 라이선스가 명시된 일부 문서 및 삽화 제외) 기여하신 문서의 저작권은 각 기여자에게 있으며, 각 기여자는 기여하신 부분의 저작권

namu.wiki

 

삼성 통합 USB 드라이버

다운로드 자료실 | 스스로해결 | 삼성전자서비스 (samsungsvc.co.kr)

 

다운로드 자료실 | 스스로해결 | 삼성전자서비스

다운로드 자료실 원하시는 정보를 못 찾으셨다면 아래 서비스를 이용해보세요. 문제해결이 되지 않거나 어려우시다면 인공지능 채팅 로봇으로 상담을 받아보시기 바랍니다. 무상 보증기간 이

www.samsungsvc.co.kr

 

The Open GApps Project

 

The Open GApps Project

 

opengapps.org

 

Releases · topjohnwu/Magisk (github.com)

 

Releases · topjohnwu/Magisk

The Magic Mask for Android. Contribute to topjohnwu/Magisk development by creating an account on GitHub.

github.com

 

Instructions-n7100 – MHS Solutions (mhs-solutions.com)

 

Instructions-n7100 – MHS Solutions

Instructions how to install any of html6405’s custom roms on a Samsung Galaxy Note 2 3G General steps: Backup all your important data.Download ROMDownload gapps (arm, pico) if you want Playstore functionalityInstall TWRP with Odin, Heimdall or do a in re

www.mhs-solutions.com

 

'SI개발 > 스마트폰' 카테고리의 다른 글

커스텀롬 설치를 위한 사전 준비: ADB 설치  (0) 2023.01.07

오래된 안드로이드 폰(노트2 등)에 커스텀롬을 설치하기 위해서 ADB를 설치해 줍니다.

설치라기 보다는 압축해제여서 윈도우에 큰 부담도 없어보입니다.

 

루팅이 아니라도 버튼 여러개(볼륨 Up + 홈 + 전원, 볼륨 Down + 홈 + 전원) 동시에 누르기 보다 커맨드 사용이 더 편리한 것 같네요.

 

1. 다운로드 및 압축해제

SDK 플랫폼 도구 출시 노트  |  Android 개발자  |  Android Developers

 

SDK 플랫폼 도구 출시 노트  |  Android 개발자  |  Android Developers

Android SDK 플랫폼 도구는 Android SDK의 구성요소입니다.

developer.android.com

 

2. 환경 변수-시스템 변수-Path에 폴더위치 추가

3. Path 잡혔는지 확인: > adb version

4. 스마트폰: 개발자옵션-ADB 디버깅 활성화, 기본 USB설정: 파일전송

5. ADB 명령어

> adb reboot recovery -- 리커버리 모드로 부팅

> adb reboot download -- 다운로드 모드로 부팅

> adb shell

$ pm list packages -f

> adb install Magisk-v23.0.apk

> adb install -r Magisk-v23.0.apk -- 재설치

※ 관련링크

안드로이드 adb 설치 및 설정 방법 (tistory.com)  

 

안드로이드 adb 설치 및 설정 방법

Android ADB (Android Debug Bridge)는 PC와 스마트 폰 간에 통신을 할 수 있는 명령어도 도구입니다. 안드로이드 개발자에게는 apk 설치, log 출력의 등의 개발에 많은 활동에서 adb를 거의 매일 사용하고 있

kibua20.tistory.com

디벨로이드 : ADB 재부팅 하기(Reboot) (develoid.github.io)

 

디벨로이드 : ADB 재부팅 하기(Reboot)

adb reboot adb reboot 커맨드를 이용해서 System, Recovery, Bootloader 등의 상태로 기기 재시작이 가능합니다. 주의사항 개발자 옵션 에서 ADB 디버깅 이 활성화 되어있어야 합니다. 개발자 옵션은 설정 > 휴

develoid.github.io

 

용기란 중압감을 이겨내는 것 :: adb 명령어 모음 (tistory.com)

 

adb 명령어 모음

안녕하세요. 오늘은 오랜만에 안드로이드 관련 정보를 정리해보려고 합니다. 매번 할때마다 대충 찾아보고 하긴 했었는데요. 이대로는 안되겠다 싶어 정리를 하려고 합니다. 그것은 바로 안드

mybeautiful-life.tistory.com

 

'SI개발 > 스마트폰' 카테고리의 다른 글

갤럭시 노트2 커스텀 롬  (0) 2023.01.07

파일이 자주 추가되거나 삭제될때 사용하기 위해 기존의 버전을 업그레이드 했습니다.

To Do List: 메인함수 module화

'Force the explicit declaration of variables
Option Explicit

' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2017-Oct-28             Initial Release
' 2         2017-Oct-28             Enter the folder name
' 3         2017-Oct-29             Use File Dialog
' 4         2022-Dec-11             Copy Sheet
' 5         2022-Dec-12             Add DateCreated
' 6         2022-Dec-26             addRow, setRowCnt
' 7         2022-Dec-28             Add one line of summary for statistics
' 8         2023-Jan-10             Format month and day(date)
' 9         2023-Jan-19             Total File Size, walkaround for the compile error of format(date, "mm")
' **************************************************************************************


Sub ListFiles()

     'Set a reference to Microsoft Scripting Runtime by using
     'Tools > References in the Visual Basic Editor (Alt+F11)
     
     'Declare the variables
     Dim objFSO As FileSystemObject
     Dim objFolder As Folder
     Dim objFile As File
     Dim strPath As String
     Dim strFile As String
     Dim NextRow As Long
     Dim dblFileSize As Double
     Dim dblFileTotalSize As Double
     
     
     'Added Codes Begin
     Dim Msg As String
     
     Call clearContents
     
     'Open the file dialog
     With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            'MsgBox (.SelectedItems(1))
            strPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
     End With
  
     
     'Msg = "Write down the folder name, please: " & vbCr
     'Msg = Msg & "e.g. C:\Users\Steve\Documents\Vids\"
     'strPath = Trim(InputBox(Msg, "Input"))
  
     If right(strPath, 1) <> "\" Then strPath = strPath & "\"
     
     'Added Codes End
     
     'Create an instance of the FileSystemObject
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     
     'Get the folder
     Set objFolder = objFSO.GetFolder(strPath)
     
     'If the folder does not contain files, exit the sub
     If objFolder.Files.Count = 0 Then
         MsgBox "No files were found...", vbExclamation
         Exit Sub
     End If
     
     'Turn off screen updating
     Application.ScreenUpdating = False
     
     'Insert the headers for Columns A, B, C, and D
     Cells(1, "A").Value = "File Name"
     Cells(1, "B").Value = "Path"
     Cells(1, "C").Value = "Size"
     Cells(1, "D").Value = "Created Date"
     
     'Find the next available row
     NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
     
     'Loop through each file in the folder
     For Each objFile In objFolder.Files
     
         'List the name, size, and date/time of the current file
         Cells(NextRow, 1).Value = objFile.Name
         'Cells(NextRow, 2).Value = objFile.Path
         Cells(NextRow, 2).Value = objFile.ParentFolder
         'Cells(NextRow, 3).Value = objFile.Size
         dblFileSize = objFile.Size
         Cells(NextRow, 3).Value = dblFileSize
         'Cells(NextRow, 3).Value = format(Round(dblFileSize / 1000000, 0), "#,#") & " MB" 'Format(n, "#,#")

         Cells(NextRow, 4).Value = objFile.DateCreated
         
         'Determine the next row
         NextRow = NextRow + 1
         dblFileTotalSize = dblFileTotalSize + dblFileSize
     
     Next objFile
     
     'Change the width of the columns to achieve the best fit
     'Columns.AutoFit
     'Format Cells
     Range(Cells(2, 3), Cells(Rows.Count, "D").End(xlUp)).Select
     Selection.HorizontalAlignment = xlRight
     Range(Cells(2, 4), Cells(Rows.Count, "D").End(xlUp)).Select
     Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm"
     Selection.HorizontalAlignment = xlCenter
     Range("A1").Select
     
    Call copySheet
    
    Dim searchCnt As Long
    Dim Cell As Range
    For Each Cell In ActiveSheet.UsedRange.Columns(1).Cells
        If InStr(Cell.Value, "_error_") > 0 Then
            searchCnt = searchCnt + 1
        End If
    Next Cell
    'MsgBox "searchCnt = " & searchCnt
    
    Call addRow
    Call addFilter
    Call setRowCnt(searchCnt, dblFileTotalSize)
    Range("A1").Select
    
    'Turn screen updating back on
    Application.ScreenUpdating = True
         
End Sub

Private Sub clearContents()
    Worksheets("listFiles").Range("A1").EntireColumn.EntireRow.clearContents
End Sub

Private Sub copySheet()
    'Sheets(1).Copy after:=Sheets(1)
    Sheets(1).Copy after:=Sheets(ActiveWorkbook.Sheets.Count)
   
    'Remove Buttons
    Dim I As Long
    Dim xOLE As Object
    ActiveSheet.Buttons.Delete
    For Each xOLE In ActiveSheet.OLEObjects
        If TypeName(xOLE.Object) = "CommandButton" Then
            xOLE.Delete
        End If
    Next
  
    Dim n As Integer
    Dim shtName As String
    Dim dtToday As Date
    Dim sMonth As String
    
    'MsgBox (Year(Date) & Month(Date) & Day(Date))
    'shtName = "List_" & Year(Date) & Month(Date) & Day(Date)
    dtToday = Date
    sMonth = Month(dtToday)
    If Len(sMonth) = 1 Then
        sMonth = "0" & sMonth
    End If
    'shtName = "List_" & Year(dtToday) & format(dtToday, "mm") & format(dtToday, "dd")
    shtName = "List_" & Year(dtToday) & sMonth & format(dtToday, "dd")
    
    
    'Format(Now, "yyyy/mm/dd/hh/mm/ss")
    'dtToday = Now
    'shtName = "List_" & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now)
    'shtName = "List_" & Year(dtToday) & Month(dtToday) & Day(dtToday) & Hour(dtToday) & Minute(dtToday) & Second(dtToday)
    'shtName = "List_" & Year(dtToday) & format(dtToday, "mm") & Day(dtToday) & Hour(dtToday) & Minute(dtToday) & Second(dtToday)
    
    
    Do While (shCheck(shtName))
        shtName = shtName & " (2)"
        'shtName = Replace(shtName, "_", "")
    Loop
    'Sheets(2).Name = shtName
    ActiveSheet.Name = shtName
End Sub

' 해당시트가 있으면 True를, 그렇지 않으면 False 를 반환합니다
Private Function shCheck(shName$) As Boolean
   On Error GoTo ec1
   If CBool(Len(Sheets(shName$).Name)) Then shCheck = True
   Exit Function
ec1:
   shCheck = False
End Function

Private Sub addRow()
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

Private Sub addFilter()
    Range("A2:D2").Select
    Selection.AutoFilter
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Range("B3").Select
    ActiveWindow.FreezePanes = True
    
    'Range("A1").Select
End Sub

Private Sub setRowCnt(ByVal searchCnt As Long, ByVal dblFileTotalSize As Double)
    'MsgBox "searchCnt = " & searchCnt
    Dim rowCnt As Long
    rowCnt = Range("a3", Range("a2").End(xlDown)).Rows.Count
    rowCnt = rowCnt - searchCnt
    
    Cells(1, 1) = "Number of Working Games"
    Cells(1, 2) = rowCnt
    Cells(1, 3) = "Excluded"
    Cells(1, 4) = searchCnt
    Cells(1, 5) = "Total Size"

    If (dblFileTotalSize > 1000000000) Then
        Cells(1, 6) = format(Round(dblFileTotalSize / 1000000000, 0), "#,#") & " GB" 'Format(n, "#,#")
    Else
        Cells(1, 6) = dblFileTotalSize
    End If
    
    Range("A1").Select
    Selection.HorizontalAlignment = xlCenter
    Range("C1").Select
    Selection.HorizontalAlignment = xlCenter
    Columns("E:E").EntireColumn.AutoFit
    Range("E1").Select
    Selection.HorizontalAlignment = xlCenter
    Columns("F:F").EntireColumn.AutoFit
    Range("F1").Select
    Selection.Style = "Comma [0]"
    
End Sub

listFiles_v4_20221211.xls
0.40MB
listFiles_v5_20221212_upload.xls
0.25MB
listFiles_v6_20221226.xls
0.16MB

※ 서브 디렉토리 포함(기존에 됐었던 것 같은데, 안되네요. 필요시 다음 링크 참조)

[vba] 하위폴더 내의 모든 파일 정보 가져오기 :: 개발하는 디자이너의 DIY 일상 (tistory.com)

 

[vba] 하위폴더 내의 모든 파일 정보 가져오기

일을 하다 보면 가끔 업무를 진행하던 경로 하위에 있는 데이들의 리스트를 만들어야 하는 경우가 있습니다. 하나의 폴더라면 어떻게 해보겠는데 그 폴더가 하위 뎁스가 연속해서 있고 저장되

diy-dev-design.tistory.com

 

같은 프로젝트에서 일했던 동료가 보내준 글(모든 링크는 하단에)을 보고 이 글을 씁니다.

 

요약하자면 글 쓰신 분(한정수 님)은 좋은 대학(본문의 힌트를 보니 S대로 추정됨)을 나왔고, 좋은 회사를 다니고, 원하는 일을 하고 있는데, 미국영주권이 나와서 바로 퇴사.

 

미국에 가는 이유는 미세먼지가 없고, 인구밀도가 낮으며, 해변이 가깝고, 아파트보다 주택, 취미생활을 하기에 더 적합한 여건을 갖추었기 때문이라고 밝혔다.

 

서울의 심각한 미세먼지 수준(2021. 12)
미세먼지 양호할때(수치: 28) (2022.01)

 

서울 전경(Nina Evensen, 2019)

 

다행이도(?) 한정수님은 국비지원학원을 다녔음에도 "SI의 리스크"를 이미 알았기에 SI를 택하지 않았다는게 신의 한수. (해당 링크도 역시 하단에 게재). 하지만, SI가 아니라고 해도 프로그래머인 제 지인도 삼성전자를 다니고 있지만 미국영주권을 얻었고, 이주를 할 계획이며 저 또한 해외로 이주할 계획을 가지고 있습니다. 

 

아무래도 워라밸, 낭만적인 생활을 실현하기에 한국은 아직 토대가 마련되지 않았다고 느껴집니다. 다만 미국은 한국보다도 업무강도가 더 쎌 수 있다고 봐서 저는 다른 나라로 고려중입니다. 한국에서 프로그래머 특히 SI개발자를 꿈꾸는 신입 분들이 계시다면 맨하단의 "관련 링크"는 꼭 읽어보고 준비하시길 권해드립니다.

 

아울러 2016년에 작성했던 제 글도 링크합니다:

2016.01.09 - [SI개발] - 막장 프로젝트 구별법

 

왜 능력이 뛰어난 개발자 분들이 SI바닥을 빨리 떠날까? 라는 의문이 있었는데, 수십년 겪어보니 괜히 치킨집 드립하는게 아니라고 느껴집니다. 그중에서도 용기내신 분, 능력있으신 분 혹은 자산 되시는 분들은 해외로 가시는듯하고요.

 

※ 관련 링크(제목 클릭)

1. "체대 출신 개발자의 2021년 회고" (Integerous DevLog, 2021)

2. "체대 출신 개발자의 2018년 회고" (Integerous DevLog, 2018)

3. "개발자의 삶 - SI 개발자란" (Karen, 2018)

 

'SI개발' 카테고리의 다른 글

막장 프로젝트 구별법  (2) 2016.01.09

부동산 실거래가 자료를 기록하기 시작했습니다. 버전이 2007이다 보니 동적 레전드 기능이 안되서 vba로 작성했습니다. 생각나는대로 기능위주로 만들다보니 Module화랑 Interface가 빈약한 점은 추후 개선해보도록 하겠습니다. 파일은 주요 아파트가 기록이 되어있기에 삭제되는대로 첨부하겠습니다.

 

' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2021-03-25             Initial Release
' **************************************************************************
'Force the explicit declaration of variables
Option Explicit
Sub add_Click()
    Call add    '계열 추가 호출
End Sub
Sub del_Click()
    Call del '계열 삭제 호출
End Sub
Sub copy_Click()
    Call copyRange  '범위 복사 호출
End Sub
Sub copyNm_Click()
    Call copyNm     '이름 복사 호출
End Sub
Sub init_Click()
    Call initialize '초기화 호출
End Sub
Sub sort_Click()
    Call sortRoi    '수익률 정렬
End Sub


'계열 추가
Private Sub add()
    'ActiveChart.PlotArea.Select
    If ActiveChart Is Nothing Then
        MsgBox "차트를 선택해주세요", vbExclamation, "Chart"
        Exit Sub
    Else
    End If
    
    Dim lngSerCnt, lngLastRow As Long
    Dim strDel As String
    Dim strAddSrs As String
    lngSerCnt = ActiveChart.SeriesCollection.Count + 1
    
    strDel = Trim(ActiveSheet.OLEObjects("txtDel").Object.Text)
    'strDel = Replace(strDel, Chr(10), "") 'vbLf
    'strDel = Replace(strDel, Chr(13), "") 'vbCr
    If strDel = "" Then
        MsgBox "추가할 계열명을 입력해주세요", vbExclamation, "Chart"
        Exit Sub
    End If
    
    strAddSrs = Trim(ActiveSheet.OLEObjects("txtAddSrs").Object.Text)
    If strAddSrs = "" Then
        MsgBox "계열범위를 복사해주세요", vbExclamation, "Chart"
        Exit Sub
    End If
    
    'lngLastRow = Cells(1, 1).End(xlDown).Row
    'MsgBox lngLastRow
    
    Application.ScreenUpdating = False
    ActiveChart.SeriesCollection.NewSeries
    'ActiveChart.SeriesCollection(lngSerCnt).Name = "=서울!$D$2"
    ActiveChart.SeriesCollection(lngSerCnt).Name = strDel
    'ActiveChart.SeriesCollection(lngSerCnt).Values = "=서울!$D$3:$D$22"
    ActiveChart.SeriesCollection(lngSerCnt).Values = "=서울!" & strAddSrs & ""
    'Call initialize '초기화 호출
    Application.ScreenUpdating = True
End Sub

'계열 삭제
Private Sub del()
    'Declare the variables
    Dim lngSerCnt As Long
    Dim strDel As String
        
    'ActiveChart.PlotArea.Select
    If ActiveChart Is Nothing Then
        MsgBox "차트를 선택해주세요", vbExclamation, "Chart"
        
        Exit Sub
    Else
    End If

    'MsgBox ActiveSheet.OLEObjects("txtDel").Object.Value, vbExclamation, "Chart"
    strDel = Trim(ActiveSheet.OLEObjects("txtDel").Object.Text)
    strDel = Replace(strDel, Chr(10), "") 'vbLf
    strDel = Replace(strDel, Chr(13), "") 'vbCr
    strDel = Trim(strDel)
    'MsgBox strDel, vbExclamation, "Chart"

    If strDel = "" Then
        MsgBox "삭제할 계열명을 입력해주세요", vbExclamation, "Chart"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    
    With ActiveChart
     DoEvents
        For lngSerCnt = .SeriesCollection.Count To 1 Step -1
            If .SeriesCollection(lngSerCnt).Name = strDel Then .SeriesCollection(lngSerCnt).Delete
        Next lngSerCnt
    End With
    Call initialize '초기화 호출
    Application.ScreenUpdating = True
End Sub

'초기화
Private Sub initialize()
    ActiveSheet.OLEObjects("txtDel").Object.Text = ""
    ActiveSheet.OLEObjects("txtAddSrs").Object.Text = ""
End Sub

'이름 복사
Private Sub copyNm()
    Dim strSelRng As String 'Selection.Address
    
    If ActiveChart Is Nothing Then
        strSelRng = Selection.Text
        If strSelRng = "" Then
            MsgBox "선택하신 계열명이 공백입니다.", vbExclamation, "Chart"
            ActiveSheet.OLEObjects("txtDel").Object.Text = ""
            Exit Sub
        End If
        ActiveSheet.OLEObjects("txtDel").Object.Text = strSelRng
    Else
        
        MsgBox "계열명을 선택해주세요", vbExclamation, "Chart"
        ActiveSheet.OLEObjects("txtDel").Object.Text = ""
        Exit Sub
    End If

End Sub

'범위 복사
Private Sub copyRange()
    'Range("서울").CurrentRegion.Copy
    Dim strSelRng As String 'Selection.Address
    
    If ActiveChart Is Nothing Then
        strSelRng = Selection.Address
        ActiveSheet.OLEObjects("txtAddSrs").Object.Text = strSelRng
    Else
        MsgBox "복사할 범위를 선택해주세요", vbExclamation, "Chart"
        ActiveSheet.OLEObjects("txtAddSrs").Object.Text = ""
        Exit Sub
    End If
End Sub

'수익률 정렬
Private Sub sortRoi()
    Dim strSelCell As String '선택셀
    Dim LastRow As Long
    Dim rngSort As Range '정렬범위
    strSelCell = ActiveCell.Address
   
    Worksheets("ROI").Range("A1").EntireColumn.EntireRow.Clear 'Sheet(ROI) 초기화
    
    'Copy
    Worksheets("서울").Range("A2").EntireRow.Select
    Selection.Copy
    Sheets("ROI").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    
    Worksheets("서울").Activate
    Worksheets("서울").Range(strSelCell).EntireRow.Select
    Selection.Copy
    Sheets("ROI").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

    'Delete empty rows
    Columns("B").SpecialCells(4).EntireRow.Delete
    Columns("A:A").EntireColumn.AutoFit
    
    Range(Range("A1", "B1"), Range("A1:B1").End(xlDown)).Select
    Set rngSort = Selection
    
    ActiveWorkbook.Worksheets("ROI").Sort.SortFields.Clear
    'ActiveWorkbook.Worksheets("ROI").Sort.SortFields.add Key:=Range("B2:B11"),
    ActiveWorkbook.Worksheets("ROI").Sort.SortFields.add Key:=Range("B2", Range("B2").End(xlDown)), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("ROI").Sort
        '.SetRange Range("A1:B11")
        .SetRange rngSort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'cell형식: 비율
    Range("B2", Range("B2").End(xlDown)).Select
    Selection.Style = "Percent"
    
    '테두리
    rngSort.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    '제목 가운데 정렬
    Range("A1:B1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A1").Select

End Sub

디렉토리(폴더)내의 파일 목록을 구하는 함수입니다.

다중선택은 안되고, 서브폴더까지 검색합니다.

ToDo: Target root 폴더에 파일이 없으면 종료되는 문제(서브디렉토리 파일 count까지 합하도록 변경 필요) -> 이부분 해결 방법 아시는 분은 댓글 남겨주시면 감사하겠습니다.

 

listFiles_v3.xls

 

내용은 다음과 같습니다.

'Force the explicit declaration of variables
Option Explicit

' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2017-Oct-28             Initial Release
' 2         2017-Oct-28             Enter the folder name
' 3         2017-Oct-29             Use File Dialog
' **************************************************************************************


Sub ListFiles()
     'Declare the variables
     Dim objFSO As FileSystemObject
     Dim objFolder As Folder
     Dim objFile As File
     Dim strPath As String
     Dim strFile As String
     Dim NextRow As Long
    
     'Added Codes Begin
     Dim Msg As String
    
     Call clearContents
    
     'Open the file dialog
     With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            'MsgBox (.SelectedItems(1))
            strPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
     End With
 
    
     'Msg = "Write down the folder name, please: " & vbCr
     'Msg = Msg & "e.g. C:\Users\Steve\Documents\Vids\"
     'strPath = Trim(InputBox(Msg, "Input"))
 
     If right(strPath, 1) <> "\" Then strPath = strPath & "\"
    
     'Added Codes End
    
     'Create an instance of the FileSystemObject
     Set objFSO = CreateObject("Scripting.FileSystemObject")
    
     'Get the folder
     Set objFolder = objFSO.GetFolder(strPath)
    
     'If the folder does not contain files, exit the sub
     If objFolder.Files.Count = 0 Then
         MsgBox "No files were found...", vbExclamation
         Exit Sub
     End If
    
     'Turn off screen updating
     Application.ScreenUpdating = False
    
     'Insert the headers for Columns A, B, and C
     Cells(1, "A").Value = "FileName"
     Cells(1, "B").Value = "Path"
     Cells(1, "C").Value = "Size"
    
     'Find the next available row
     NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    
     'Loop through each file in the folder
     For Each objFile In objFolder.Files
    
         'List the name, size, and date/time of the current file
         Cells(NextRow, 1).Value = objFile.Name
         Cells(NextRow, 2).Value = objFile.Path
         Cells(NextRow, 3).Value = objFile.Size
        
         'Determine the next row
         NextRow = NextRow + 1
    
     Next objFile
    
     'Change the width of the columns to achieve the best fit
     'Columns.AutoFit
    
     'Turn screen updating back on
     Application.ScreenUpdating = True
        
End Sub

Sub clearContents()
    Worksheets("List").Range("A1").EntireColumn.EntireRow.clearContents
End Sub

 

그리드의 체크박스가 1개만 선택하도록 하는 예제입니다. Xplatform과 넥사크로만 써오다가 이번에 처음으로 마이플랫폼을 접해봤는데, 구현방식이 꽤 달라서, 두개 모두 제시합니다. 마이플랫폼->Xplatform->넥사크로와 같이 버전업이 되어왔는데, 셋중에 Xplatform이 제일 난듯합니다. 넥사크로는 코딩 효율이 너무 떨어지는 단점이 있고요, 창업주3인방이 회사 매각후 나가서 그런걸까요? 차기버전은 좀더 효율성 높고 안정적으로 만들어 주었으면 합니다.

 

1. XPlatform

function Dataset00_onrowposchanged(obj:Dataset, e:DSRowPosChangeEventInfo)
{
     obj.setColumn(e.oldrow, "Column0", false );
}

function Dataset01_oncolumnchanged(obj:Dataset, e:DSColChangeEventInfo)
{
     for(var i=0; i<obj.getColCount(); i++){
          if( obj.getColID(i) != e.columnid )
           obj.setColumn(e.row, obj.getColID(i), false );
     } 
}

 

2. Miplatform

function ABC_CanColumnChange(obj,nRow,strColumnID,varOldValue,varNewValue,nPivotIndex)
{
    this.ABC.fireevent = false;
if(this.ABC.CaseCount("column0==1") > 0 )
{
    for(var i = 0; i< this.ABC.GetRowCount(); i++)
    {
        this.ABC.SetColumn(i, "column0", 0);
    }
}
    this.ABC.SetColumn(nRow, "column0", varNewValue);
    this.ABC.fireevent = true;
}

 

ItemListv0.7_20160327.xls

 

 

 

 

Sub DeleteEmptyRows()
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = LastRow To 1 Step -1
        If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r
End Sub

Sub DeleteEmptyHeaders()
    'Delete the row if column A is empty
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = LastRow To 2 Step -1 'Exclude the first row from the range
        'If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
        If Application.CountA(Cells(r, 1)) = 0 Then Rows(r).Delete
    Next r
    removeColor
End Sub

Sub sortJefOS()
'
' sortJefOS Macro
'
' Hardcoded for only one worksheet of Jimmy's log(Jef-X: Magic&OS)

    Dim srt As Sort
       
    Set srt = ActiveSheet.Sort
   
    With srt.SortFields
        .Clear
        .Add Key:=Columns("H"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Number of sockets
        .Add Key:=Columns("I"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Base
        .Add Key:=Columns("A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Account
        .Add Key:=Columns("B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Character
    End With
   
    'With ActiveWorkbook.Worksheets("Magic&OS").Sort
    With srt
        .SetRange Cells
        .Header = xlYes             'My data has headers
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    DeleteEmptyHeaders
End Sub

Sub removeColor()
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
Sub stripTag()
    'Cells.Select
    'Dim rngSelected As Range
    'Set rngSelected = New Cells.Select
    'Call stripHtml(rngSelected) 'html제거
    Cells.Hyperlinks.Delete 'hyperlink 제거
    ActiveSheet.Pictures.Delete '그림 제거
End Sub
Function stripHtml(cell As Range) As String

Dim RegEx As Object
 Set RegEx = CreateObject("vbscript.regexp")
Dim sInput As String
 Dim sOut As String
 sInput = cell.Text

sInput = Replace(sInput, "\x0D\x0A", Chr(10))
 sInput = Replace(sInput, "\x00", Chr(10))

'replace HTML breaks and end of paragraphs with line breaks
 sInput = Replace(sInput, "</P>", Chr(10) & Chr(10))
 sInput = Replace(sInput, "<BR>", Chr(10))

'replace bullets with dashes
 sInput = Replace(sInput, "<li>", "-")

'add back all of the special characters
 sInput = Replace(sInput, "&ndash;", "?")
sInput = Replace(sInput, "&mdash;", "?")
sInput = Replace(sInput, "&iexcl;", "¡")
sInput = Replace(sInput, "&iquest;", "¿")
sInput = Replace(sInput, "&quot;", "")
sInput = Replace(sInput, "&ldquo;", "“")
sInput = Replace(sInput, "&rdquo;", "”")
sInput = Replace(sInput, "", "‘")
sInput = Replace(sInput, "&lsquo;", "‘")
sInput = Replace(sInput, "&rsquo;", "’")
sInput = Replace(sInput, "&laquo;", "≪")
sInput = Replace(sInput, "&raquo;", "≫")
sInput = Replace(sInput, "&nbsp;", " ")
sInput = Replace(sInput, "&amp;", "&")
sInput = Replace(sInput, "&cent;", "¢")
sInput = Replace(sInput, "&copy;", "ⓒ")
sInput = Replace(sInput, "&divide;", "÷")
sInput = Replace(sInput, "&gt;", ">")
sInput = Replace(sInput, "&lt;", "<")
sInput = Replace(sInput, "&micro;", "μ")
sInput = Replace(sInput, "&middot;", "·")
sInput = Replace(sInput, "&para;", "¶")
sInput = Replace(sInput, "&plusmn;", "±")
sInput = Replace(sInput, "&euro;", "€")
sInput = Replace(sInput, "&pound;", "£")
sInput = Replace(sInput, "&reg;", "®")
sInput = Replace(sInput, "&sect;", "§")
sInput = Replace(sInput, "&trade;", "™")
sInput = Replace(sInput, "&yen;", "¥")
sInput = Replace(sInput, "&aacute;", "a")
sInput = Replace(sInput, "&Aacute;", "A")
sInput = Replace(sInput, "&agrave;", "a")
sInput = Replace(sInput, "&Agrave;", "A")
sInput = Replace(sInput, "&acirc;", "a")
sInput = Replace(sInput, "&Acirc;", "A")
sInput = Replace(sInput, "&aring;", "a")
sInput = Replace(sInput, "&Aring;", "A")
sInput = Replace(sInput, "&atilde;", "a")
sInput = Replace(sInput, "&Atilde;", "A")
sInput = Replace(sInput, "&auml;", "a")
sInput = Replace(sInput, "&Auml;", "A")
sInput = Replace(sInput, "&aelig;", "æ")
sInput = Replace(sInput, "&AElig;", "Æ")
sInput = Replace(sInput, "&ccedil;", "c")
sInput = Replace(sInput, "&Ccedil;", "C")
sInput = Replace(sInput, "&eacute;", "e")
sInput = Replace(sInput, "&Eacute;", "E")
sInput = Replace(sInput, "&egrave;", "e")
sInput = Replace(sInput, "&Egrave;", "E")
sInput = Replace(sInput, "&ecirc;", "e")
sInput = Replace(sInput, "&Ecirc;", "E")
sInput = Replace(sInput, "&euml;", "e")
sInput = Replace(sInput, "&Euml;", "E")
sInput = Replace(sInput, "&iacute;", "i")
sInput = Replace(sInput, "&Iacute;", "I")
sInput = Replace(sInput, "&igrave;", "i")
sInput = Replace(sInput, "&Igrave;", "I")
sInput = Replace(sInput, "&icirc;", "i")
sInput = Replace(sInput, "&Icirc;", "I")
sInput = Replace(sInput, "&iuml;", "i")
sInput = Replace(sInput, "&Iuml;", "I")
sInput = Replace(sInput, "&ntilde;", "n")
sInput = Replace(sInput, "&Ntilde;", "N")
sInput = Replace(sInput, "&oacute;", "o")
sInput = Replace(sInput, "&Oacute;", "O")
sInput = Replace(sInput, "&ograve;", "o")
sInput = Replace(sInput, "&Ograve;", "O")
sInput = Replace(sInput, "&ocirc;", "o")
sInput = Replace(sInput, "&Ocirc;", "O")
sInput = Replace(sInput, "&oslash;", "ø")
sInput = Replace(sInput, "&Oslash;", "Ø")
sInput = Replace(sInput, "&otilde;", "o")
sInput = Replace(sInput, "&Otilde;", "O")
sInput = Replace(sInput, "&ouml;", "o")
sInput = Replace(sInput, "&Ouml;", "O")
sInput = Replace(sInput, "&szlig;", "ß")
sInput = Replace(sInput, "&uacute;", "u")
sInput = Replace(sInput, "&Uacute;", "U")
sInput = Replace(sInput, "&ugrave;", "u")
sInput = Replace(sInput, "&Ugrave;", "U")
sInput = Replace(sInput, "&ucirc;", "u")
sInput = Replace(sInput, "&Ucirc;", "U")
sInput = Replace(sInput, "&uuml;", "u")
sInput = Replace(sInput, "&Uuml;", "U")
sInput = Replace(sInput, "&yuml;", "y")
sInput = Replace(sInput, "", "´")
sInput = Replace(sInput, "", "`")

'replace all the remaining HTML Tags
 With RegEx
 .Global = True
 .IgnoreCase = True
 .MultiLine = True
 .Pattern = "<[^>]+>" 'Regular Expression for HTML Tags.

End With
 sOut = RegEx.Replace(sInput, "")
stripHtml = sOut
 Set RegEx = Nothing

End Function

 

현재 프로젝트의 단순작업에 걸리는 시간을 줄이기 위해 만들어봤습니다.

단순한 코딩이고요. 개선하실 사안이 있으시면 변경하시거나 의견주셔도 됩니다.

파일 첨부했어요.

 

fab.xls - 초기버전

 

fab_v2.xls - LastRow를 변수로 교체

 

 

즐코딩~

 

코드만 보시려는 분들을 위해 내용도 붙여넣을께요

 

'---------------------------------------------------------------------------------------
' Procedure : Convert DB column names to Camel and Pascal cases
' Author    : Sean
' Purpose   : Reduce repetitive and time consuming converting tasks
' Copyright : I do not claim any copyrights over this code. The following may be altered and reused as you wish
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' DB Column Names   : Place column names in column A of Columns sheet.
'
' Usage:
' ~~~~~~
' ?camelCase()
'       Convert to Camel Case
' ?pascalCase()
'       Convert to Pascal Case
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2016-Mar-26             Initial Release
' **************************************************************************************
' Columns: DB column names
' Components: Nexacro component names
' Variables: VO variable and dataset column names
'
' ToDo.1: For문의 max값은 Range(Selection, Selection.End(xlDown)).Select 등을 이용하여 상수에서 변수로 변경.
'

Sub convert()
    'MsgBox "test"
  
    Worksheets("Components").Range("A1").EntireColumn.EntireRow.clearContents
    Worksheets("Variables").Range("A1").EntireColumn.EntireRow.clearContents
   
    copyRows
    Application.CutCopyMode = False
   
   
    Worksheets("Columns").Select
    Range("A1").Select
   
    pascalCase  'Components
    camelCase   'Variables

End Sub

Sub copyRows()
    Worksheets("Columns").Range("A1").EntireColumn.Select
    Selection.Copy
   
    Sheets("Variables").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
    Sheets("Components").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Sub pascalCase()
    Dim strCase As String
   
    Worksheets("Components").Select
    For x = 1 To 65536
        If (Len(Cells(x, 1)) > 0) Then
            strCase = Application.Substitute(Application.Proper(Cells(x, 1)), "_", "")
            strCase = "_" & strCase
            Cells(x, 1) = strCase
        End If
    Next
   
End Sub

Sub camelCase()
    Dim strCase As String
   
    Worksheets("Variables").Select
    'For Each x In Range("A1").EntireColumn
    For x = 1 To 65536
        'x.Value = LCase(x.Value)
        If (Len(Cells(x, 1)) > 0) Then
            strCase = Application.Substitute(Application.Proper(Cells(x, 1)), "_", "")
       
            'If (Len(strCase) > 0) Then
                Mid(strCase, 1, 1) = LCase(Mid(strCase, 1, 1))
            'End If
            Cells(x, 1) = strCase
        End If
    Next
   
End Sub

Sub clearContents()
    Worksheets("Columns").Range("A1").EntireColumn.EntireRow.clearContents
    Worksheets("Components").Range("A1").EntireColumn.EntireRow.clearContents
    Worksheets("Variables").Range("A1").EntireColumn.EntireRow.clearContents
End Sub

1 2 

글 보관함

카운터

Total : / Today : / Yesterday :
get rsstistory!