幸せのちから

          平凡的世界
          看似平常實(shí)崎嶇
          成如容易卻艱辛

          VBA參考

          Sub 辭書コードを取得()

          Dim intCount_JISYO_CD As Integer
          Dim intUUNo_JISYO_CD As Integer
          intCount_JISYO_CD 
          = 3
          intUUNo_JISYO_CD 
          = 2
          '辭書コードをSheetn5に作成します、重複の場合スキップします
          Do While Len(Worksheets("Sheet2").Cells(intCount_JISYO_CD, 13).Value) > 1
              
          Set Obj = Worksheets("Sheet5").Cells.Find(Worksheets("Sheet2").Cells(intCount_JISYO_CD, 13).Value, LookAt:=xlWhole)
              
          If Obj Is Nothing Then
                  Worksheets(
          "Sheet5").Cells(intUUNo_JISYO_CD, 1).Value = Worksheets("Sheet2").Cells(intCount_JISYO_CD, 13).Value
                  intUUNo_JISYO_CD 
          = intUUNo_JISYO_CD + 1
              
          End If
              intCount_JISYO_CD 
          = intCount_JISYO_CD + 1
          Loop

          'Sheet5に作成された辭書コードを昇準(zhǔn)にソートします
          '
          Worksheets("Sheet5").Active
          Worksheets("Sheet5").Range(Cells(11), Cells(intUUNo_JISYO_CD, 1)).Sort Key1:=Worksheets("Sheet5").Cells(11), order1:=xlAscending

          End Sub

          Sub 辭書コードが存在しない部品()

          Dim intCount_JISYO_CD As Integer
          Dim intNum_Record As Integer
          intCount_JISYO_CD 
          = 3
          intNum_Record 
          = 3
          '辭書コードが存在しない部品をSheet6に作成します
          Do While Len(Worksheets("Sheet2").Cells(intCount_JISYO_CD, 13).Value) > 1
              
          If Worksheets("Sheet2").Cells(intCount_JISYO_CD, 13).Value = "C5416" Or Worksheets("Sheet2").Cells(intCount_JISYO_CD, 13).Value = "C5860" Then
              Worksheets(
          "Sheet2").Cells(intCount_JISYO_CD, 13).EntireRow.Copy
              Worksheets(
          "Sheet6").Cells(intNum_Record, 1).EntireRow.Insert
              intNum_Record 
          = intNum_Record + 1
              
          End If
              intCount_JISYO_CD 
          = intCount_JISYO_CD + 1
          Loop
          End Sub

          Sub 重複レコードを削除します()
          Dim intRows As Integer
          Dim intUniqueRows As Integer
          intRows 
          = 1
          intUniqueRows 
          = 1
          Do While Len(Worksheets("Sheet7").Cells(intRows, 1).Value) > 1
              
          Set Obj = Worksheets("Sheet9").Cells.Find(Worksheets("Sheet7").Cells(intRows, 1).Value, LookAt:=xlWhole)
              
          If Obj Is Nothing Then
                  Worksheets(
          "Sheet7").Cells(intRows, 1).EntireRow.Copy
                  Worksheets(
          "Sheet9").Cells(intUniqueRows, 1).EntireRow.Insert
                  intUniqueRows 
          = intUniqueRows + 1
              
          End If
              intRows 
          = intRows + 1
          Loop
          End Sub

          posted on 2011-03-24 17:09 Lucky 閱讀(2630) 評(píng)論(0)  編輯  收藏 所屬分類: 其他

          <2011年3月>
          272812345
          6789101112
          13141516171819
          20212223242526
          272829303112
          3456789

          導(dǎo)航

          隨筆分類(125)

          文章分類(5)

          日本語

          搜索

          積分與排名

          最新隨筆

          最新評(píng)論

          主站蜘蛛池模板: 松桃| 晋宁县| 密山市| 吴江市| 景德镇市| 宿松县| 泸州市| 永清县| 崇信县| 铁岭市| 上杭县| 化州市| 大城县| 大厂| 晋中市| 建昌县| 报价| 内江市| 宜良县| 商河县| 尼勒克县| 且末县| 梓潼县| 四平市| 久治县| 封开县| 综艺| 济南市| 惠水县| 新乡县| 阿勒泰市| 盐池县| 荔波县| 库伦旗| 夏津县| 易门县| 德令哈市| 东丽区| 赤壁市| 亚东县| 子洲县|